User: ben Date: 05/02/16 01:48:33 Modified: xemacs/tests Tag: ben-glyph glyph-test.el gutter-test.el Added: xemacs/src Tag: ben-glyph redisplay-xlike.c Log: First check-in of ben-glyph branch Revision Changes Path No revision No revision 1.16.4.1 +252 -89 XEmacs/xemacs/lib-src/make-docfile.c Index: make-docfile.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lib-src/make-docfile.c,v retrieving revision 1.16 retrieving revision 1.16.4.1 diff -u -r1.16 -r1.16.4.1 --- make-docfile.c 2004/12/06 03:50:53 1.16 +++ make-docfile.c 2005/02/16 00:40:17 1.16.4.1 ＠＠ -3,7 +3,7 ＠＠ Free Software Foundation, Inc. Copyright (C) 1995 Board of Trustees, University of Illinois. Copyright (C) 1998, 1999 J. Kean Johnston. - Copyright (C) 2001, 2002 Ben Wing. + Copyright (C) 2001, 2002, 2003, 2005 Ben Wing. This file is part of XEmacs. ＠＠ -25,20 +25,25 ＠＠ /* Synched up with: FSF 21.3. */ /* The arguments given to this program are all the C and Lisp source files - of XEmacs. .elc and .el and .c files are allowed. - A .o or .obj file can also be specified; the .c file it was made from is used. - This helps the makefile pass the correct list of files. - - The results, which go to standard output or to a file - specified with -a or -o (-a to append, -o to start from nothing), - are entries containing function or variable names and their documentation. - Each entry starts with a ^_ character. - Then comes F for a function or V for a variable. - Then comes the function or variable name, terminated with a newline. - Then comes the documentation for that function or variable. + of XEmacs. .elc and .el and .c files are allowed. + A .o or .obj file can also be specified; the .c file it was made from is + used. This helps the makefile pass the correct list of files. + + The results, which go to standard output or to a file + specified with -a or -o (-a to append, -o to start from nothing), + are entries containing function or variable names and their documentation. + Each entry starts with a ^_ character. + Then comes F for a function or V for a variable. + Then comes the function or variable name, terminated with a newline. + Then comes the documentation for that function or variable. + + Numerous changes for XEmacs -- handle ISO2022 sequences; handle + DEFUN_WITH_KEYWORDS; handle args with trailing underscore; different + format in DOC for arguments; handle different DEFUN format, with doc + string in a comment; etc. - Added 19.15/20.1: `-i site-packages' allow installer to dump extra packages - without modifying Makefiles, etc. + Added 19.15/20.1: `-i site-packages' allow installer to dump extra packages + without modifying Makefiles, etc. */ #include <config.h> ＠＠ -51,17 +56,8 ＠＠ #include "compiler.h" -/* XEmacs addition */ -#define C_IDENTIFIER_CHAR_P(c) \ - (('A' <= c && c <= 'Z') || \ - ('a' <= c && c <= 'z') || \ - ('0' <= c && c <= '9') || \ - (c == '_')) - static int scan_file (const char *filename); static int read_c_string (FILE *, int, int); -static void write_c_args (FILE *out, const char *func, char *buf, int minargs, - int maxargs); static int scan_c_file (const char *filename, const char *mode); static void skip_white (FILE *); static void read_lisp_symbol (FILE *, char *); ＠＠ -493,19 +489,38 ＠＠ return c; }  + +enum keyword_props + { + KEYWORD_NONE, + KEYWORD_ALLOW_OTHER, + }; + +/* Allow - and & because we may be reading an argument list from a comment + -- particularly when the DEFUN is MANY or UNEVALLED */ +#define IDENTIFIER_CHAR_P(c) \ + (('A' <= c && c <= 'Z') || \ + ('a' <= c && c <= 'z') || \ + ('0' <= c && c <= '9') || \ + (c == '_') || \ + (c == '-') || (c == '&')) + /* Write to file OUT the argument names of function FUNC, whose text is in BUF. - MINARGS and MAXARGS are the minimum and maximum number of arguments. */ + MINARGS and MAXARGS are the minimum and maximum number of arguments. + If the function has keyword args, they are in KEYWORDARGS; else, it's + NULL. */ static void write_c_args (FILE *out, const char *UNUSED (func), char *buf, - int minargs, int maxargs) + char *keywordargs, int minargs, int maxargs, + enum keyword_props kprops) { register char *p; int in_ident = 0; int just_spaced = 0; -#if 0 - int need_space = 1; + int lambda_keyword = 0; +#if 0 fprintf (out, "(%s", func); #else /* XEmacs - "arguments:" is for parsing the docstring. FSF's help system ＠＠ -525,10 +540,11 ＠＠ char c = *p; int ident_start = 0; +#if 0 /* Not used in XEmacs */ /* XEmacs addition: add support for ANSI prototypes. Hop over "Lisp_Object" string (the only C type allowed in DEFUNs) */ static char lo[] = "Lisp_Object"; - if ((C_IDENTIFIER_CHAR_P (c) != in_ident) && !in_ident && + if ((IDENTIFIER_CHAR_P (c) != in_ident) && !in_ident && (strncmp (p, lo, sizeof (lo) - 1) == 0) && isspace ((unsigned char) p[sizeof (lo) - 1])) { ＠＠ -537,22 +553,19 ＠＠ p++; c = *p; } +#endif /* Notice when we start printing a new identifier. */ - if (C_IDENTIFIER_CHAR_P (c) != in_ident) + if (IDENTIFIER_CHAR_P (c) != in_ident) { if (!in_ident) { in_ident = 1; ident_start = 1; -#if 0 - /* XEmacs - This goes along with the change above. */ - if (need_space) - putc (' ', out); -#endif if (minargs == 0 && maxargs > 0) fprintf (out, "&optional "); just_spaced = 1; + lambda_keyword = c == '&'; minargs--; maxargs--; ＠＠ -573,22 +586,11 ＠＠ #if 0 /* In C code, `default' is a reserved word, so we spell it `defalt'; unmangle that here. */ - if (ident_start - && strncmp (p, "defalt", 6) == 0 - && ! (('A' <= p[6] && p[6] <= 'Z') - || ('a' <= p[6] && p[6] <= 'z') - || ('0' <= p[6] && p[6] <= '9') - || p[6] == '_')) - { - fprintf (out, "DEFAULT"); - p += 5; - in_ident = 0; - just_spaced = 0; - } + ... deleted; #endif - /* If the C argument name ends with `_', change it to ' ', - to allow use of C reserved words or global symbols as Lisp args. */ - if (c == '-' && ! C_IDENTIFIER_CHAR_P (p[1])) + /* If the C argument name ends with `_', eat it, to allow use of + C reserved words or global symbols as Lisp args. */ + if (c == '-' && ! IDENTIFIER_CHAR_P (p[1])) { in_ident = 0; just_spaced = 0; ＠＠ -604,20 +606,110 ＠＠ { putc('\\', out); putc('\r', out); + } + else if (isspace ((unsigned char) c)) + { + if (!just_spaced) + putc (' ', out); + just_spaced = 1; } - else if (c != ' ' || !just_spaced) + else { - if (c >= 'a' && c <= 'z') - /* Upcase the letter. */ - c += 'A' - 'a'; - putc (c, out); + just_spaced = 0; + if (c != ')') + { + if (!lambda_keyword) + c = toupper ((unsigned char) c); + putc (c, out); + } } + } + + if (keywordargs) + { + fprintf (out, " &key "); + just_spaced = 1; + + if (*keywordargs == '(') + keywordargs++; + + for (p = keywordargs; *p; p++) + { + char c = *p; + int ident_start = 0; + + /* Notice when we start printing a new identifier. */ + if (IDENTIFIER_CHAR_P (c) != in_ident) + { + if (!in_ident) + { + in_ident = 1; + ident_start = 1; + just_spaced = 1; + /* Prefix keyword with a colon, which does not appear in + the args. #### In a defun specification, the colon + does not appear -- e.g. + + (defun foo (shlemiel shlimazel &key humpty dumpty) ...) + + but in CLTL2, descriptions of such functions are + given like + + foo SHLEMIEL SHLIMAZEL &key :humpty :dumpty + + (where italics are actually used in place of caps). + Since we also the description by putting vars in caps, + analogous to italics, it seems we should follow the + convention. --ben + + */ + putc (':', out); + } + else + in_ident = 0; + } - just_spaced = (c == ' '); + /* Print the C argument list as it would appear in lisp: + print underscores as hyphens, and print commas and newlines + as spaces. Collapse adjacent spaces into one. */ + if (c == '_') + c = '-'; + else if (c == ',' || c == '\n') + c = ' '; + #if 0 - need_space = 0; + /* In C code, `default' is a reserved word, so we spell it + `defalt'; unmangle that here. */ + ... deleted; #endif + + /* If the C argument name ends with `_', eat it, to allow use of + C reserved words or global symbols as Lisp args. */ + if (c == '-' && ! IDENTIFIER_CHAR_P (p[1])) + { + in_ident = 0; + just_spaced = 0; + } + else if (isspace ((unsigned char) c)) + { + if (!just_spaced) + putc (' ', out); + just_spaced = 1; + } + else + { + just_spaced = 0; + if (c != ')') + putc (c, out); + } + } + + if (kprops == KEYWORD_ALLOW_OTHER) + fprintf (out, " &allow-other-keys"); } + + putc (')', out); + /* XEmacs addition */ if (!ellcc) putc ('\n', out); ＠＠ -625,20 +717,18 ＠＠  /* Read through a c file. If a .o or .obj file is named, the corresponding .c file is read instead. - Looks for DEFUN constructs such as are defined in ../src/lisp.h. - Accepts any word starting DEF... so it finds DEFSIMPLE and DEFPRED ... - which don't exist anymore! */ + Looks for DEFVAR_*, DEFUN, DEFUN_WITH_KEYWORDS. +*/ static int scan_c_file (const char *filename, const char *mode) { FILE *infile; register int c; - register int commas; - register int defunflag; - register int defvarperbufferflag = 0; - register int defvarflag; + register int commas, commas_so_far; + register int defunflag, defun_with_keywords_flag, defvarflag; int minargs, maxargs; + int allow_other_keywords = 0; int l = strlen (filename); char f[QXE_PATH_MAX]; ＠＠ -675,6 +765,9 ＠＠ c = '\n'; while (!feof (infile)) { + defunflag = 0; + defvarflag = 0; + defun_with_keywords_flag = 0; if (c != '\n') { c = getc (infile); ＠＠ -707,12 +800,13 ＠＠ continue; defvarflag = 1; - defunflag = 0; c = getc (infile); +#if 0 /* Note that this business doesn't apply under XEmacs. DEFVAR_BUFFER_LOCAL in XEmacs behaves normally. */ defvarperbufferflag = (c == 'P'); +#endif c = getc (infile); } ＠＠ -724,10 +818,17 ＠＠ c = getc (infile); if (c != 'F') continue; + c = getc (infile); + /* XEmacs addition */ + if (c != 'U') + continue; + c = getc (infile); + if (c != 'N') + continue; + defunflag = 1; c = getc (infile); - defunflag = (c == 'U'); - defvarflag = 0; - c = getc (infile); /* XEmacs addition */ + if (c == '_') + defun_with_keywords_flag = 1; } else continue; ＠＠ -743,21 +844,30 ＠＠ continue; c = read_c_string (infile, -1, 0); - if (defunflag) + if (defun_with_keywords_flag) + commas = 6; + else if (defunflag) commas = 4; - else if (defvarperbufferflag) - commas = 2; else if (defvarflag) commas = 1; - else /* For DEFSIMPLE and DEFPRED ... which now don't exist! */ - commas = 2; + else + { +#if 0 + /* DEFSIMPLE or DEFPRED -- not in XEmacs */ + commas = 2; +#else + abort (); +#endif + } + commas_so_far = 0; while (commas) { if (c == ',') { commas--; - if (defunflag && (commas == 1 || commas == 2)) + commas_so_far++; + if (defunflag && (commas_so_far == 2 || commas_so_far == 3)) { do c = getc (infile); ＠＠ -765,7 +875,7 ＠＠ if (c < 0) goto eof; ungetc (c, infile); - if (commas == 2) /* pick up minargs */ + if (commas_so_far == 2) /* pick up minargs */ fscanf (infile, "%d", &minargs); else /* pick up maxargs */ if (c == 'M' || c == 'U') /* MANY || UNEVALLED */ ＠＠ -773,6 +883,17 ＠＠ else fscanf (infile, "%d", &maxargs); } + if (defun_with_keywords_flag && commas_so_far == 5) + { /* pick up keyword props arg */ + do + c = getc (infile); + while (c == ' ' || c == '\n' || c == '\t') + ; + if (c < 0) + goto eof; + if (c == 'A') + allow_other_keywords = 1; + } } if (c < 0) goto eof; ＠＠ -831,19 +952,28 ＠＠ /* If this is a defun, find the arguments and print them. If this function takes MANY or UNEVALLED args, then the C source - won't give the names of the arguments, so we shouldn't bother - trying to find them. */ - if (defunflag && maxargs != -1) + may indicate the proper args with a comment, so look for it + and then skip the actual args, which will be uninteresting + (int nargs, Lisp_Object *args). */ + if (defunflag) { char argbuf[1024], *p = argbuf; -#if 0 /* For old DEFUN's only */ - while (c != ')') + char keywordbuf[1024]; + if (maxargs == -1) { - if (c < 0) - goto eof; - c = getc (infile); + while (c != '/' && c != '(') + { + if (c < 0) + goto eof; + c = getc (infile); + } + if (c == '/') + { + c = getc (infile); + if (c != '*') + goto no_arguments; + } } -#endif /* Skip into arguments. */ while (c != '(') { ＠＠ -854,20 +984,53 ＠＠ /* Copy arguments into ARGBUF. */ *p++ = c; do - { - *p++ = c = getc (infile); - if (c < 0) - goto eof; - } + *p++ = c = getc (infile); while (c != ')'); *p = '\0'; + if (maxargs == -1) /* Skip the real arguments. */ + { + do + { + c = getc (infile); + if (c < 0) + goto eof; + } + while (c != ')'); + } + + /* Find keyword arguments if necessary. */ + if (defun_with_keywords_flag) + { + p = keywordbuf; + while (c != '(') + { + if (c < 0) + goto eof; + c = getc (infile); + } + /* Copy arguments into ARGBUF. */ + *p++ = c; + do + { + *p++ = c = getc (infile); + if (c < 0) + goto eof; + } + while (c != ')'); + *p = '\0'; + } /* Output them. */ if (ellcc) fprintf (outfile, "\\n\\\n\\n\\\n"); else fprintf (outfile, "\n\n"); - write_c_args (outfile, globalbuf, argbuf, minargs, maxargs); + write_c_args (outfile, globalbuf, argbuf, + defun_with_keywords_flag ? keywordbuf : 0, + minargs, maxargs, + allow_other_keywords ? KEYWORD_ALLOW_OTHER : + KEYWORD_NONE); } + no_arguments: if (ellcc) fprintf (outfile, "\\n\");\n\n"); } No revision No revision 1.639.4.1 +63 -0 XEmacs/xemacs/lisp/ChangeLog Index: ChangeLog =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/ChangeLog,v retrieving revision 1.639 retrieving revision 1.639.4.1 diff -u -r1.639 -r1.639.4.1 --- ChangeLog 2005/02/10 03:26:14 1.639 +++ ChangeLog 2005/02/16 00:40:28 1.639.4.1 ＠＠ -1,3 +1,66 ＠＠ +2002-05-20 Ben Wing <ben(a)xemacs.org&gt; + + Eliminate obsolete.el; put stuff back into the files where they + belong. + + Changes related to corresponding changes in src/. + + Define Ctrl-Delete to be kill-word (its old defn of clear-selection + still works when there's a selection, with appropriate changes + to pending-del). + + Rearrange some stuff in subr.el to follow logical categories and + document them. + +2002-05-05 Ben Wing <ben(a)xemacs.org&gt; + + * bytecomp-runtime.el (with-obsolete-variable): + * bytecomp-runtime.el (with-obsolete-function): + Doc string changes. + + * compat.el: + * compat.el (compat-current-package): + * compat.el (compat-current-package)): New. + * compat.el (compat-define-compat-functions): New. + * compat.el (compat-define-group): + * compat.el (compat-define-functions): Removed. + * compat.el (compat-defun): New. + * compat.el (compat-define-function): New. + * compat.el (compat-wrap-runtime): New. + * compat.el (compat-wrap): New. + * compat.el (compat): Removed. + * compat.el (overlays): + * compat.el (overlayp): New. + * compat.el (make-overlay): New. + * compat.el (move-overlay): New. + * compat.el (delete-overlay): New. + * compat.el (overlay-start): New. + * compat.el (overlay-end): New. + * compat.el (overlay-buffer): New. + * compat.el (overlay-properties): New. + * compat.el (overlays-at): New. + * compat.el (overlays-in): New. + * compat.el (next-overlay-change): New. + * compat.el (previous-overlay-change): New. + * compat.el (overlay-lists): New. + * compat.el (overlay-recenter): New. + * compat.el (overlay-get): New. + * compat.el (overlay-put): New. + * compat.el ('delete-extent): New. + * compat.el ('extent-end-position): New. + * compat.el ('extent-start-position): New. + * compat.el ('set-extent-endpoints): New. + * compat.el ('set-extent-property): New. + * compat.el ('make-extent): New. + * compat.el (extent-property): New. + * compat.el (extent-at): New. + * compat.el (map-extents): New. Some attempts to redo this to + make it truly useful and fix the "multiple versions interacting + with each other" problem. Not yet done. Currently doesn't work. + + * files.el (revert-buffer-internal): + Use with-obsolete-variable to avoid warnings in new revert-buffer code. + 2005-02-09 Ben Wing <ben(a)xemacs.org&gt; * dumped-lisp.el (preloaded-file-list): 1.18.6.1 +0 -4 XEmacs/xemacs/lisp/cl-extra.el Index: cl-extra.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/cl-extra.el,v retrieving revision 1.18 retrieving revision 1.18.6.1 diff -u -r1.18 -r1.18.6.1 --- cl-extra.el 2004/11/04 23:05:54 1.18 +++ cl-extra.el 2005/02/16 00:40:35 1.18.6.1 ＠＠ -47,10 +47,6 ＠＠ ;;; Code: -;; XEmacs addition -(eval-when-compile - (require 'obsolete)) - (or (memq 'cl-19 features) (error "Tried to load `cl-extra' before `cl'!")) 1.16.6.1 +8 -8 XEmacs/xemacs/lisp/cmdloop.el Index: cmdloop.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/cmdloop.el,v retrieving revision 1.16 retrieving revision 1.16.6.1 diff -u -r1.16 -r1.16.6.1 --- cmdloop.el 2003/05/02 06:32:29 1.16 +++ cmdloop.el 2005/02/16 00:40:36 1.16.6.1 ＠＠ -108,15 +108,15 ＠＠ ((string-match "^ \\*" (buffer-name (current-buffer))) (bury-buffer)))) -;; `cancel-mode-internal' is a function of a misc-user event, which is -;; queued when window system directs XEmacs frame to cancel any modal -;; behavior it exposes, like mouse pointer grabbing. +;; `cancel-mode-internal' is called from the C code in response to a +;; notify-cancel-mode event, which is queued when window system directs +;; XEmacs frame to cancel any modal behavior it exposes, like mouse pointer +;; grabbing. ;; -;; This function does nothing at the top level, but the code which -;; runs modal event loops, such as selection drag loop in `mouse-track', -;; check if misc-user function symbol is `cancel-mode-internal', and -;; takes necessary cleanup actions. -(defun cancel-mode-internal (object) +;; This function does nothing at the top level, but the code which runs +;; modal event loops, such as selection drag loop in `mouse-track', checks +;; if such an event is received, and takes necessary cleanup actions. +(defun cancel-mode-internal () (setq zmacs-region-stays t))  ;; Someone wrote: "This should really be a ring of last errors." 1.8.6.1 +26 -0 XEmacs/xemacs/lisp/device.el Index: device.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/device.el,v retrieving revision 1.8 retrieving revision 1.8.6.1 diff -u -r1.8 -r1.8.6.1 --- device.el 2004/03/08 15:22:49 1.8 +++ device.el 2005/02/16 00:40:37 1.8.6.1 ＠＠ -164,4 +164,30 ＠＠ (defalias 'device-type-list 'console-type-list) (defalias 'device-pixel-depth 'device-bitplanes) +;;;;;;;;;;;;;;;;;;;;;;;;;;;; device obsoleteness + +(make-compatible-variable 'window-system "use (console-type)") + +(defun x-display-color-p (&optional device) + "Return t if DEVICE is a color device." + (eq 'color (device-class device))) +(make-compatible 'x-display-color-p 'device-class) + +(define-function 'x-color-display-p 'x-display-color-p) +(make-compatible 'x-display-color-p 'device-class) + +(defun x-display-grayscale-p (&optional device) + "Return t if DEVICE is a grayscale device." + (eq 'grayscale (device-class device))) +(make-compatible 'x-display-grayscale-p 'device-class) + +(define-function 'x-grayscale-display-p 'x-display-grayscale-p) +(make-compatible 'x-display-grayscale-p 'device-class) + +(define-compatible-function-alias 'x-display-pixel-width 'device-pixel-width) +(define-compatible-function-alias 'x-display-pixel-height 'device-pixel-height) +(define-compatible-function-alias 'x-display-planes 'device-bitplanes) +(define-compatible-function-alias 'x-display-color-cells 'device-color-cells) + + ;;; device.el ends here 1.3.10.1 +44 -35 XEmacs/xemacs/lisp/dialog-items.el Index: dialog-items.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/dialog-items.el,v retrieving revision 1.3 retrieving revision 1.3.10.1 diff -u -r1.3 -r1.3.10.1 --- dialog-items.el 2002/06/04 06:04:15 1.3 +++ dialog-items.el 2005/02/16 00:40:37 1.3.10.1 ＠＠ -1,7 +1,7 ＠＠ ;;; dialog-items.el --- Dialog-box content for XEmacs ;; Copyright (C) 2000 Andy Piper. -;; Copyright (C) 2000 Ben Wing. +;; Copyright (C) 2000, 2002 Ben Wing. ;; Maintainer: XEmacs Development Team ;; Keywords: content, gui, internal, dumped ＠＠ -34,23 +34,23 ＠＠ (defvar search-dialog-regexp nil) (defvar search-dialog nil) -(defun search-dialog-callback (parent image-instance event) +(defun search-dialog-callback (parent event) (save-selected-frame (select-frame parent) - (let ((domain (frame-selected-window (event-channel event)))) - (funcall (if search-dialog-direction - (if search-dialog-regexp - 're-search-forward - 'search-forward) - (if search-dialog-regexp - 're-search-backward - 'search-backward)) - (glyph-image-property - (car (glyph-image-property - (nth 1 (glyph-image-property - search-dialog :items domain)) - :items domain)) :text domain)) - (isearch-highlight (match-beginning 0) (match-end 0))))) + (funcall (if search-dialog-direction + (if search-dialog-regexp 're-search-forward 'search-forward) + (if search-dialog-regexp 're-search-backward 'search-backward)) + (image-instance-property + (find-image-instance (image-instance-parent + (event-image-instance event)) + :tag 'edit) + :text)) + (isearch-highlight (match-beginning 0) (match-end 0)))) + +(defun search-dialog-cancel-callback (event) + (interactive "e") + (isearch-dehighlight) + (delete-frame (event-frame event))) (defun make-search-dialog () "Popup a search dialog box." ＠＠ -60,6 +60,7 ＠＠ 'general :parent parent :title "Search" + :cancel-callback 'search-dialog-cancel-callback :autosize t :spec (setq search-dialog ＠＠ -74,21 +75,21 ＠＠ :justify top ; implies left also :items ([string :data "Search for:"] - [button :descriptor "Match Case" + [button :descriptor "%_Match Case" :style toggle :selected (not case-fold-search) :callback (setq case-fold-search (not case-fold-search))] - [button :descriptor "Regular Expression" + [button :descriptor "%_Regular Expression" :style toggle :selected search-dialog-regexp :callback (setq search-dialog-regexp (not search-dialog-regexp))] - [button :descriptor "Forwards" + [button :descriptor "F%_orwards" :style radio :selected search-dialog-direction :callback (setq search-dialog-direction t)] - [button :descriptor "Backwards" + [button :descriptor "%_Backwards" :style radio :selected (not search-dialog-direction) :callback (setq search-dialog-direction nil)] ＠＠ -96,21 +97,29 ＠＠ [layout :orientation vertical :vertically-justify top :horizontally-justify right - :items - ([edit-field :width 15 :descriptor "" :active t - :initial-focus t] - [button :width 10 :descriptor "Find Next" - :callback-ex - (lambda (image-instance event) - (search-dialog-callback ,parent - image-instance - event))] - [button :width 10 :descriptor "Cancel" - :callback-ex - (lambda (image-instance event) - (isearch-dehighlight) - (delete-frame - (event-channel event)))])])])) + :items + ([edit-field :width 15 :tag edit + :descriptor "" :active t + :focus t + :callback + (lambda (event) + (interactive "e") + ;; when ENTER pressed, focus on the + ;; Find-Next widget + (focus-image-instance + (find-image-instance + (image-instance-parent + (event-image-instance event)) + :tag find)))] + [button :width 10 :tag find :descriptor "%_Find Next" + :callback + (lambda (event) + (interactive "e") + (search-dialog-callback + ,parent event))] + [button :width 10 :descriptor "%_Cancel" + :callback 'search-dialog-cancel-callback + ])])])) ;; These are no longer strictly necessary, but not setting a size ;; at all yields a much more noticeable resize since the initial ;; frame is so big. 1.11.12.1 +38 -35 XEmacs/xemacs/lisp/dragdrop.el Index: dragdrop.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/dragdrop.el,v retrieving revision 1.11 retrieving revision 1.11.12.1 diff -u -r1.11 -r1.11.12.1 --- dragdrop.el 2002/03/15 07:43:18 1.11 +++ dragdrop.el 2005/02/16 00:40:37 1.11.12.1 ＠＠ -1,6 +1,7 ＠＠ ;;; dragdrop.el --- window system-independent Drag'n'Drop support. ;; Copyright (C) 1998 Oliver Graf <ograf(a)fga.de&gt; +;; Copyright (C) 2002 Ben Wing. ;; Maintainer: XEmacs Development Team, Oliver Graf <ograf(a)fga.de&gt; ;; Keywords: mouse, gui, dumped ＠＠ -88,9 +89,8 ＠＠ "*{EXPERIMENTAL} This is the standart drop function search list. Each element is a list of a function, a button selector, a modifier selector and optional argumets to the function call. -The function must accept at least two arguments: first is the event -of the drop, second the object data, followed by any of the optional -arguments provided in this list. +The function must accept at one argument: first is the event +of the drop, followed by any of the optional arguments provided in this list. The functions are called in order, until one returns t." :group 'drag-n-drop :type '(repeat dragdrop-function-widget)) ＠＠ -117,15 +117,22 ＠＠ ;; ;; Drop API ;; -(defun dragdrop-drop-dispatch (object) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun default-drop-event-handler (event) + "For use as the value of `drop-event-handler'." "*{EXPERIMENTAL} This function identifies DROP type misc-user-events. It calls functions which will handle the drag." - (let ((event current-mouse-event)) - (and dragdrop-drop-log - (experimental-dragdrop-drop-log-function event object)) - (dragdrop-drop-find-functions event object))) + (and dragdrop-drop-log + (experimental-dragdrop-drop-log-function event)) + (dragdrop-drop-find-functions event)) + +(setq drop-event-handler 'default-drop-event-handler) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + -(defun dragdrop-drop-find-functions (event object) +(defun dragdrop-drop-find-functions (event) "Finds valid drop-handle functions and executes them to dispose the drop. It does this by looking for extent-properties called 'experimental-dragdrop-drop-functions and for variables named like this." ＠＠ -145,13 +152,12 ＠＠ (while (not (eq ext nil)) (dragdrop-drop-do-functions (extent-property ext 'experimental-dragdrop-drop-functions) - event - object) + event) (setq ext (extent-at pos buffer 'experimental-dragdrop-drop-functions ext))))))) ;; now look into the variable experimental-dragdrop-drop-functions - (dragdrop-drop-do-functions experimental-dragdrop-drop-functions event object))) + (dragdrop-drop-do-functions experimental-dragdrop-drop-functions event))) (defun dragdrop-compare-mods (first-mods second-mods) "Returns t if both first-mods and second-mods contain the same elements. ＠＠ -165,8 +171,8 ＠＠ (and (eq moda ()) (eq modb ())))) -(defun dragdrop-drop-do-functions (drop-funs event object) - "Calls all functions in drop-funs with object until one returns t. +(defun dragdrop-drop-do-functions (drop-funs event) + "Calls all functions in DROP-FUNS with EVENT until one returns t. Returns t if one of drop-funs returns t. Otherwise returns nil." (let ((flist nil) (button (event-button event)) ＠＠ -177,13 +183,13 ＠＠ (= (cadr flist) button)) (or (eq (caddr flist) t) (dragdrop-compare-mods (caddr flist) mods)) - (apply (car flist) `(,event ,object ,＠(cdddr flist))) - ;; (funcall (car flist) event object) + (apply (car flist) `(,event ,＠(cdddr flist))) + ;; (funcall (car flist) event) (throw 'dragdrop-drop-is-done t)) (setq drop-funs (cdr drop-funs)))) nil) -(defun experimental-dragdrop-drop-log-function (event object &optional message buffer) +(defun experimental-dragdrop-drop-log-function (event &optional message buffer) "*{EXPERIMENTAL} Logs any drops into a buffer. If buffer is nil, it inserts the data into a buffer called after dragdrop-drop-log-name. ＠＠ -210,13 +216,13 ＠＠ (event-button event) (event-modifiers event))) (insert (format " data is of type %s (%d %s)\n" - (cond ((eq (car object) 'dragdrop-URL) "URL") - ((eq (car object) 'dragdrop-MIME) "MIME") + (cond ((eq (event-drop-data-type event) 'dragdrop-URL) "URL") + ((eq (event-drop-data-type event) 'dragdrop-MIME) "MIME") (t "UNKNOWN")) - (length (cdr object)) - (if (= (length (cdr object)) 1) "element" "elements"))) + (length (event-drop-data event)) + (if (= (length (event-drop-data event)) 1) "element" "elements"))) (let ((i 1) - (data (cdr object))) + (data (event-drop-data event))) (while (not (eq data ())) (insert (format " Element %d: %S\n" i (car data))) ＠＠ -225,11 +231,11 ＠＠ (insert "----------\n")) nil) -(defun experimental-dragdrop-drop-url-default (event object) +(defun experimental-dragdrop-drop-url-default (event) "*{EXPERIMENTAL} Default handler for dropped URL data. -Finds files and URLs. Returns nil if object does not contain URL data." - (cond ((eq (car object) 'dragdrop-URL) - (let* ((data (cdr object)) +Finds files and URLs. Returns nil if EVENT does not contain URL data." + (cond ((eq (event-drop-data-type event) 'dragdrop-URL) + (let* ((data (event-drop-data event)) (frame (event-channel event)) (x pop-up-windows) (window (or (event-window event) ＠＠ -257,12 +263,12 ＠＠ t)) (t nil))) -(defun experimental-dragdrop-drop-mime-default (event object) +(defun experimental-dragdrop-drop-mime-default (event) "*{EXPERIMENTAL} Default handler for dropped MIME data. Inserts text into buffer, creates MIME buffers for other types. -Returns nil if object does not contain MIME data." - (cond ((eq (car object) 'dragdrop-MIME) - (let ((ldata (cdr object)) +Returns nil if EVENT does not contain MIME data." + (cond ((eq (event-drop-data-type event) 'dragdrop-MIME) + (let ((ldata (event-drop-data event)) (frame (event-channel event)) (x pop-up-windows) (data nil)) ＠＠ -347,11 +353,8 ＠＠ ;; ;; Drag API ;; -(defun experimental-dragdrop-drag (event object) - "*{EXPERIMENTAL} The generic drag function. -Tries to do the best with object in the selected protocol. -Object must comply to the standart drag'n'drop object -format." +(defun experimental-dragdrop-drag (event) + "*{EXPERIMENTAL} The generic drag function." (error "Not implemented")) (defun experimental-dragdrop-drag-region (event begin end) 1.54.4.1 +0 -1 XEmacs/xemacs/lisp/dumped-lisp.el Index: dumped-lisp.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/dumped-lisp.el,v retrieving revision 1.54 retrieving revision 1.54.4.1 diff -u -r1.54 -r1.54.4.1 --- dumped-lisp.el 2005/02/10 03:26:15 1.54 +++ dumped-lisp.el 2005/02/16 00:40:37 1.54.4.1 ＠＠ -50,7 +50,6 ＠＠ "syntax" "device" "console" - "obsolete" "specifier" "frame" ; needed by faces (when (featurep 'x) "x-faces") ; needed by faces 1.3.28.1 +159 -17 XEmacs/xemacs/lisp/events.el Index: events.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/events.el,v retrieving revision 1.3 retrieving revision 1.3.28.1 diff -u -r1.3 -r1.3.28.1 --- events.el 1998/10/10 08:04:00 1.3 +++ events.el 2005/02/16 00:40:38 1.3.28.1 ＠＠ -2,7 +2,7 ＠＠ ;; Copyright (C) 1997 Free Software Foundation, Inc. ;; Copyright (C) 1996-7 Sun Microsystems, Inc. -;; Copyright (C) 1996 Ben Wing. +;; Copyright (C) 1996, 2002 Ben Wing. ;; Maintainer: Martin Buchholz ;; Keywords: internal, event, dumped ＠＠ -32,31 +32,115 ＠＠ ;;; Code: - -(defun event-console (event) - "Return the console that EVENT occurred on. -This will be nil for some types of events (e.g. eval events)." - (cdfw-console (event-channel event))) - (defun event-device (event) "Return the device that EVENT occurred on. This will be nil for some types of events (e.g. keyboard and eval events)." - (dfw-device (event-channel event))) + (let ((channel (event-channel event))) + (if (image-instance-p channel) + (setq channel (image-instance-domain channel))) + (dfw-device channel))) (defun event-frame (event) "Return the frame that EVENT occurred on. This will be nil for some types of events (e.g. keyboard and eval events)." - (fw-frame (event-channel event))) + (let ((channel (event-channel event))) + (if (image-instance-p channel) + (setq channel (image-instance-domain channel))) + (fw-frame channel))) + +(defun event-image-instance (event) + "Return the image instance that EVENT occurred on, or nil. +Only returns non-nil for widget events." + (let ((channel (event-channel event))) + (and (image-instance-p channel) channel))) (defun event-buffer (event) - "Return the buffer of the window over which mouse event EVENT occurred. -Return nil unless both (mouse-event-p EVENT) and -(event-over-text-area-p EVENT) are non-nil." + "Return the buffer of the window over which event EVENT occurred. +Return nil unless (event-window EVENT) is non-nil (e.g. may occur if the +event was not over a text area)." (let ((window (event-window event))) (and (windowp window) (window-buffer window)))) -(defalias 'allocate-event 'make-event) +(defun event-channel (event) + "Return the channel that the event EVENT occurred on. +This may be a window, frame, device, console, image instance, or nil for +some types of events (e.g. eval events). (See `make-event' for more +specifics on what sort of channel is associated with different event +types.) In general, use a more specific function, e.g. `event-frame' or +`event-image-instance', instead of this function." + (event-property event 'channel)) + +(defun event-key (event) + "Return the Keysym of the key-press event EVENT. +This will be a character if the event is associated with one, else a symbol." + (event-property event 'key)) + +(defun event-button (event) + "Return the button-number of the button-press or button-release event EVENT." + (event-property event 'button)) + +(defun event-process (event) + "Return the process of the process-output event EVENT." + (event-property event 'process)) + +(defun event-callback (event) + "Return the callback of the activate event EVENT." + (event-property event 'callback)) + +(defun event-text (event) + "Return the text of the activate event EVENT." + (event-property event 'text)) + +(defun event-drop-data (event) + "Return the drop data of the drop event EVENT." + (event-property event 'drop-data)) + +(defun event-drop-data-type (event) + "Return the type of the drop data of the drop event EVENT." + (event-property event 'drop-data-type)) + +(defun event-scrollbar-value (event) + "Return the scrollbar-value of the scrollbar event EVENT. +This may be a number or nil, and is passed to the scrollbar-handling function." + (event-property event 'scrollbar-value)) + +(defun event-subtype (event) + "Return the subtype of EVENT, an activate, scrollbar, or notify event. +Currently defined subtypes are: + +For activate events: + + activate-menu-selection + activate-toolbar-selection + activate-dialog-box-selection + activate-widget-action + +For scrollbar events: + + scrollbar-page-up + scrollbar-page-down + scrollbar-page-left + scrollbar-page-right + scrollbar-line-up + scrollbar-line-down + scrollbar-char-left + scrollbar-char-right + scrollbar-to-top + scrollbar-to-bottom + scrollbar-to-left + scrollbar-to-right + scrollbar-vertical-drag + scrollbar-horizontal-drag + +For notify events: + + notify-no-menu-selection + notify-dialog-box-cancelled + notify-close-frame + notify-cancel-mouse-selection" + (event-property event 'subtype)) +(defalias 'allocate-event 'make-event) (defun key-press-event-p (object) "Return t if OBJECT is a key-press event." ＠＠ -98,11 +182,47 ＠＠ "Return t if OBJECT is an eval event." (and (event-live-p object) (eq 'eval (event-type object)))) +(defun menu-event-p (object) + "Return t if OBJECT is a menu event." + (and (event-live-p object) + (eq 'activate (event-type object)) + (eq 'activate-menu-selection (event-subtype object)))) + +(defun scrollbar-event-p (object) + "Return t if OBJECT is a scrollbar event." + (and (event-live-p object) (eq 'scrollbar (event-type object)))) + +(defun toolbar-event-p (object) + "Return t if OBJECT is a toolbar event." + (and (event-live-p object) + (eq 'activate (event-type object)) + (eq 'activate-toolbar-selection (event-subtype object)))) + +(defun widget-event-p (object) + "Return t if OBJECT is a widget event." + (and (event-live-p object) + (eq 'activate (event-type object)) + (eq 'activate-widget-action (event-subtype object)))) + +(defun dialog-box-event-p (object) + "Return t if OBJECT is a dialog-box event." + (and (event-live-p object) + (eq 'activate (event-type object)) + (eq 'activate-dialog-box-selection (event-subtype object)))) + +(defun drop-event-p (object) + "Return t if OBJECT is a drop event." + (and (event-live-p object) (eq 'drop (event-type object)))) + +(defun notify-event-p (object) + "Return t if OBJECT is a notify event." + (and (event-live-p object) (eq 'notify (event-type object)))) + (defun misc-user-event-p (object) - "Return t if OBJECT is a misc-user event. -A misc-user event is a user event that is not a keypress or mouse click; -normally this means a menu selection or scrollbar action." - (and (event-live-p object) (eq 'misc-user (event-type object)))) + "Return t if OBJECT is a user event other than a keypress or mouse click. +This includes activate, notify, scrollbar and drop events." + (and (event-live-p object) + (memq (event-type object) '(activate scrollbar drop notify)))) ;; You could just as easily use event-glyph but we include this for ;; consistency. ＠＠ -112,6 +232,24 ＠＠ Mouse events are events of type button-press, button-release or motion." (and (event-live-p object) (event-glyph object) t)) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun default-notify-event-handler (event) + "For use as the value of `notify-event-handler'." + (case (event-subtype event) + ((notify-no-menu-selection notify-dialog-box-cancelled) + (run-hooks 'menu-no-selection-hook)) + (notify-close-frame + (delete-frame (event-frame event) t)) + (notify-cancel-mode + (cancel-mode-internal)) + (t (error 'internal-error "Invalid notify subtype" + (event-subtype event))))) + +(setq notify-event-handler 'default-notify-event-handler) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (defun keyboard-translate (&rest pairs) "Translate character or keysym FROM to TO at a low level. Multiple FROM-TO pairs may be specified. ＠＠ -154,5 +292,9 ＠＠ (put 'kp-subtract 'ascii-character ?-) (put 'kp-decimal 'ascii-character ?.) (put 'kp-divide 'ascii-character ?/) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;; events obsoleteness + +(make-obsolete-variable 'unread-command-char 'unread-command-events) ;;; events.el ends here 1.5.24.1 +6 -0 XEmacs/xemacs/lisp/extents.el Index: extents.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/extents.el,v retrieving revision 1.5 retrieving revision 1.5.24.1 diff -u -r1.5 -r1.5.24.1 --- extents.el 2001/04/12 18:21:17 1.5 +++ extents.el 2005/02/16 00:40:38 1.5.24.1 ＠＠ -120,4 +120,10 ＠＠ "Return EXTENT's `keymap' property." (extent-property extent 'keymap)) +;;;;;;;;;;;;;;;;;;;;;;;;;;;; extents obsoleteness + +(define-obsolete-function-alias 'extent-buffer 'extent-object) +(define-compatible-variable-alias 'parse-sexp-lookup-properties + 'lookup-syntax-properties) + ;;; extents.el ends here 1.34.8.1 +5 -0 XEmacs/xemacs/lisp/faces.el Index: faces.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/faces.el,v retrieving revision 1.34 retrieving revision 1.34.8.1 diff -u -r1.34 -r1.34.8.1 --- faces.el 2002/12/03 14:02:50 1.34 +++ faces.el 2005/02/16 00:40:38 1.34.8.1 ＠＠ -2015,4 +2015,9 ＠＠ (set-face-reverse-p 'isearch t 'global '(default tty)) ) +;;;;;;;;;;;;;;;;;;;;;;;;;;;; faces obsoleteness + +(define-obsolete-function-alias 'list-faces-display 'edit-faces) +(define-obsolete-function-alias 'list-faces 'face-list) + ;;; faces.el ends here 1.24.4.1 +78 -2 XEmacs/xemacs/lisp/frame.el Index: frame.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/frame.el,v retrieving revision 1.24 retrieving revision 1.24.4.1 diff -u -r1.24 -r1.24.4.1 --- frame.el 2005/01/28 02:58:40 1.24 +++ frame.el 2005/02/16 00:40:39 1.24.4.1 ＠＠ -2,7 +2,7 ＠＠ ;; Copyright (C) 1993, 1994, 1996, 1997, 2000, 2001, 2003 ;; Free Software Foundation, Inc. -;; Copyright (C) 1995, 1996 Ben Wing. +;; Copyright (C) 1995, 1996, 2002, 2005 Ben Wing. ;; Maintainer: XEmacs Development Team ;; Keywords: internal, dumped ＠＠ -1020,7 +1020,24 ＠＠ (defun set-frame-property (frame prop val) "Set property PROP of FRAME to VAL. See `set-frame-properties'." - (set-frame-properties frame (list prop val))) + (or frame (setq frame (selected-frame))) + (check-argument-type 'framep frame) + (put frame prop val)) + +(defun frame-property (frame property &optional default) + "Return FRAME's value for property PROPERTY. +Return DEFAULT if there is no such property. +See `set-frame-properties' for the built-in property names." + (or frame (setq frame (selected-frame))) + (check-argument-type 'framep frame) + (get frame property default)) + +(defun frame-properties (&optional frame) + "Return a property list of the properties of FRAME. +Do not modify this list; use `set-frame-property' instead." + (or frame (setq frame (selected-frame))) + (check-argument-type 'framep frame) + (object-plist frame)) ;; XEmacs change: this function differs significantly from Emacs. (defun set-background-color (color-name) ＠＠ -2001,6 +2018,65 ＠＠ (put 'cursor-color 'frame-property-alias [text-cursor background]) (put 'modeline 'frame-property-alias 'has-modeline-p) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;; frame obsoleteness + +(defun frame-first-window (frame) + "Return the topmost, leftmost window of FRAME. +If omitted, FRAME defaults to the currently selected frame." + (frame-highest-window frame 0)) +(make-compatible 'frame-first-window 'frame-highest-window) + +(define-obsolete-variable-alias 'initial-frame-alist 'initial-frame-plist) +(define-obsolete-variable-alias 'minibuffer-frame-alist + 'minibuffer-frame-plist) +(define-obsolete-variable-alias 'pop-up-frame-alist 'pop-up-frame-plist) +(define-obsolete-variable-alias 'special-display-frame-alist + 'special-display-frame-plist) + +;; Defined in C. + +(define-obsolete-variable-alias 'default-frame-alist 'default-frame-plist) +(define-obsolete-variable-alias 'default-x-frame-alist 'default-x-frame-plist) +(define-obsolete-variable-alias 'default-tty-frame-alist + 'default-tty-frame-plist) + +(make-compatible 'frame-parameters 'frame-property) +(defun frame-parameters (&optional frame) + "Return the parameters-alist of frame FRAME. +It is a list of elements of the form (PARM . VALUE), where PARM is a symbol. +The meaningful PARMs depend on the kind of frame. +If FRAME is omitted, return information on the currently selected frame. + +See the variables `default-frame-plist', `default-x-frame-plist', and +`default-tty-frame-plist' for a description of the parameters meaningful +for particular types of frames." + (or frame (setq frame (selected-frame))) + ;; #### This relies on a `copy-sequence' of the user properties in + ;; `frame-properties'. Removing that would make `frame-properties' more + ;; efficient but this function less efficient, as we couldn't be + ;; destructive. Since most callers now use `frame-parameters', we'll + ;; do it this way. Should probably change this at some point in the + ;; future. + (destructive-plist-to-alist (frame-properties frame))) + +(make-compatible 'modify-frame-parameters 'set-frame-properties) +(defun modify-frame-parameters (frame alist) + "Modify the properties of frame FRAME according to ALIST. +ALIST is an alist of properties to change and their new values. +Each element of ALIST has the form (PARM . VALUE), where PARM is a symbol. +The meaningful PARMs depend on the kind of frame. + +See `set-frame-properties' for built-in property names." + ;; it would be nice to be destructive here but that's not safe. + (set-frame-properties frame (alist-to-plist alist))) + +(make-compatible 'frame-parameter 'frame-property) +(defun frame-parameter (frame parameter) + "Return FRAME's value for parameter PARAMETER. +If FRAME is nil, describe the currently selected frame." + (cdr (assq parameter (frame-parameters frame))))  (provide 'frame) 1.7.24.1 +352 -287 XEmacs/xemacs/lisp/glyphs.el Index: glyphs.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/glyphs.el,v retrieving revision 1.7 retrieving revision 1.7.24.1 diff -u -r1.7 -r1.7.24.1 --- glyphs.el 2001/04/12 18:21:21 1.7 +++ glyphs.el 2005/02/16 00:40:39 1.7.24.1 ＠＠ -1,7 +1,7 ＠＠ ;;; glyphs.el --- Lisp interface to C glyphs ;; Copyright (C) 1994, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1995, 1996, 2000 Ben Wing. +;; Copyright (C) 1995, 1996, 2000, 2002 Ben Wing. ;; Author: Chuck Thompson <cthomp(a)cs.uiuc.edu&gt;, Ben Wing <ben(a)xemacs.org&gt; ;; Maintainer: XEmacs Development Team ＠＠ -43,263 +43,37 ＠＠ (defun make-image-specifier (spec-list) "Return a new `image' specifier object with the specification list SPEC-LIST. SPEC-LIST can be a list of specifications (each of which is a cons of a -locale and a list of instantiators), a single instantiator, or a list -of instantiators. See `make-specifier' for more information about -specifiers. - -An image specifier is used for images (pixmaps, widgets and the like). -It is used to describe the actual image in a glyph. It is instanced -as an image-instance. Note that \"image\" as used in XEmacs does not -actually refer to what the term \"image\" normally means (a picture, +locale and a list of instantiators), a single instantiator, or a list of +instantiators. See `make-specifier' for more information about specifiers, +and `make-glyph' for a detailed description of the contents of SPEC-LIST. + +NOTE: In practice, you rarely, if ever, need to actually create an +image specifier! (The function `make-image-specifier' exists mainly for +completeness.) The only built-in uses for image specifiers are as the +`image' property of a glyph (controlling the glyph's image) and the +`background-pixmap' property of faces, where it allows the user to specify +a pixmap to be used in place of a static background color. In both cases, +the image specifiers lie within other objects (glyphs, faces) and are created +automatically when the other object is created. Thus, you need not (and in +fact, cannot) put another image specifier in place. + +An image specifier is used for images (pixmaps, widgets and the like). It +is used to describe the actual image in a glyph. It is instantiated as an +image-instance. Note that \"image\" as used in XEmacs does not actually +refer to what the term \"image\" normally means (a picture, e.g. in .GIF or .JPG format, and called a \"pixmap\" in XEmacs), but includes all types of graphical elements, including pixmaps, widgets -\(buttons, sliders, text fields, etc.) and even strings of text. +\(buttons, sliders, text fields, etc.), subwindows (a child window-system +window) and even strings of text, when treated as a unit graphical element. -Note that, in practice, you rarely, if ever, need to actually create -an image specifier! (The function `make-image-specifier' exists mainly -for completeness.) Pretty much the only use for image specifiers is to -control how glyphs are displayed, and the image specifier associated -with a glyph (the `image' property of a glyph) is created -automatically when a glyph is created (see `make-glyph') and need not -\(and cannot, for that matter) ever be changed. In fact, the design -decision to create a separate image specifier type, rather than make -glyphs themselves be specifiers, is debatable -- the other properties -of glyphs are rarely used and could conceivably have been incorporated -into the glyph's instantiator. The rarely used glyph types (buffer, -pointer, icon) could also have been incorporated into the instantiator. - -Image instantiators come in many formats: `xbm', `xpm', `gif', `jpeg', -etc. This describes the format of the data describing the image. The -resulting image instances also come in many types -- `mono-pixmap', -`color-pixmap', `text', `pointer', etc. This refers to the behavior of -the image and the sorts of places it can appear. (For example, a -color-pixmap image has fixed colors specified for it, while a -mono-pixmap image comes in two unspecified shades \"foreground\" and -\"background\" that are determined from the face of the glyph or -surrounding text; a text image appears as a string of text and has an -unspecified foreground, background, and font; a pointer image behaves -like a mono-pixmap image but can only be used as a mouse pointer -\[mono-pixmap images cannot be used as mouse pointers]; etc.) It is -important to keep the distinction between image instantiator format and -image instance type in mind. Typically, a given image instantiator -format can result in many different image instance types (for example, -`xpm' can be instanced as `color-pixmap', `mono-pixmap', or `pointer'; -whereas `cursor-font' can be instanced only as `pointer'), and a -particular image instance type can be generated by many different -image instantiator formats (e.g. `color-pixmap' can be generated by `xpm', -`gif', `jpeg', etc.). - -See `make-image-instance' for a more detailed discussion of image -instance types. - -An image instantiator should be a string or a vector of the form - - [FORMAT :KEYWORD VALUE ...] - -i.e. a format symbol followed by zero or more alternating keyword-value -pairs. FORMAT should be one of - -'nothing - Don't display anything; no keywords are valid for this. - Can only be instanced as `nothing'. -'string - Display this image as a text string. Can only be instanced - as `text', although support for instancing as `mono-pixmap' - and `color-pixmap' should be added. -'formatted-string - Display this image as a text string, with replaceable fields; - not currently implemented. (It is, instead, equivalent to `string'.) -'xbm - An X bitmap; only if X or MS Windows support was compiled into this - XEmacs. Can be instanced as `mono-pixmap', `color-pixmap', or `pointer'. -'xpm - An XPM pixmap; only if XPM support was compiled into this XEmacs. - Can be instanced as `color-pixmap', `mono-pixmap', or `pointer'. -'xface - An X-Face bitmap, used to encode people's faces in e-mail messages; - only if X-Face support was compiled into this XEmacs. Can be - instanced as `mono-pixmap', `color-pixmap', or `pointer'. -'gif - A GIF87 or GIF89 image; only if GIF support was compiled into this - XEmacs. NOTE: only the first frame of animated gifs will be displayed. - Can be instanced as `color-pixmap'. -'jpeg - A JPEG image; only if JPEG support was compiled into this XEmacs. - Can be instanced as `color-pixmap'. -'png - A PNG image; only if PNG support was compiled into this XEmacs. - Can be instanced as `color-pixmap'. -'tiff - A TIFF image; only if TIFF support was compiled into this XEmacs. - Can be instanced as `color-pixmap'. -'bmp - A MS Windows BMP image; only if MS Windows support was compiled into - this XEmacs. Can be instanced as `color-pixmap'. -'cursor-font - One of the standard cursor-font names, such as \"watch\" or - \"right_ptr\" under X. Under X, this is, more specifically, any - of the standard cursor names from appendix B of the Xlib manual - [also known as the file <X11/cursorfont.h>] minus the XC_ prefix. - On other window systems, the valid names will be specific to the - type of window system. Can only be instanced as `pointer'. -'mswindows-resource - An MS Windows pointer resource. Specifies a resource to retrieve - directly from the system (an OEM resource) or from a file, particularly - an executable file. If the resource is to be retrieved from a file, use - :file and optionally :resource-id. Otherwise use :resource-id. Always - specify :resource-type to specify the type (cursor, bitmap or icon) of - the resource. Possible values for :resource-id are listed below. Can - be instanced as `pointer' or `color-pixmap'. -'font - A glyph from a font; i.e. the name of a font, and glyph index into it - of the form \"FONT fontname index [[mask-font] mask-index]\". - Currently can only be instanced as `pointer', although this should - probably be fixed. -'subwindow - An embedded windowing system window. Can only be instanced as - `subwindow'. -'button - A button widget; either a push button, radio button or toggle button. - Can only be instanced as `widget'. -'combo-box - A drop list of selectable items in a widget, for editing text. - Can only be instanced as `widget'. -'edit-field - A text editing widget. Can only be instanced as `widget'. -'label - A static, text-only, widget; for displaying text. Can only be instanced - as `widget'. -'layout - A widget for controlling the positioning of children underneath it. - Through the use of nested layouts, a widget hierarchy can be created - which can have the appearance of any standard dialog box or similar - arrangement; all of this is counted as one \"glyph\" and could appear - in many of the places that expect a single glyph. Can only be instanced - as `widget'. -'native-layout - The native version of a layout widget. #### Document me better! - Can only be instanced as `widget'. -'progress-gauge - A sliding widget, for showing progress. Can only be instanced as - `widget'. -'tab-control - A tab widget; a series of user selectable tabs. Can only be instanced - as `widget'. -'tree-view - A folding widget. Can only be instanced as `widget'. -'scrollbar - A scrollbar widget. Can only be instanced as `widget'. -'autodetect - XEmacs tries to guess what format the data is in. If X support - exists, the data string will be checked to see if it names a filename. - If so, and this filename contains XBM or XPM data, the appropriate - sort of pixmap or pointer will be created. [This includes picking up - any specified hotspot or associated mask file.] Otherwise, if `pointer' - is one of the allowable image-instance types and the string names a - valid cursor-font name, the image will be created as a pointer. - Otherwise, the image will be displayed as text. If no X support - exists, the image will always be displayed as text. Can be instanced as - `mono-pixmap', `color-pixmap', `pointer', or `text'. -'inherit - Inherit from the background-pixmap property of a face. Can only be - instanced as `mono-pixmap'. - -The valid keywords are: - -:data - Inline data. For most formats above, this should be a string. For - XBM images, this should be a list of three elements: width, height, and - a string of bit data. This keyword is valid for all of the bitmap/pixmap - formats, as well as `string', `formatted-string', `font', `cursor-font', - and `autodetect'. -:file - Data is contained in a file. The value is the name of this file. - If both :data and :file are specified, the image is created from - what is specified in :data and the string in :file becomes the - value of the `image-instance-file-name' function when applied to - the resulting image-instance. This keyword is valid for all of the - bitmap/pixmap formats as well as `mswindows-resource'. -:foreground -:background - For `xbm', `xface', `cursor-font', `widget' and `font'. These keywords - allow you to explicitly specify foreground and background colors. - The argument should be anything acceptable to `make-color-instance'. - This will cause what would be a `mono-pixmap' to instead be colorized - as a two-color color-pixmap, and specifies the foreground and/or - background colors for a pointer instead of black and white. -:mask-data - For `xbm' and `xface'. This specifies a mask to be used with the - bitmap. The format is a list of width, height, and bits, like for - :data. -:mask-file - For `xbm' and `xface'. This specifies a file containing the mask data. - If neither a mask file nor inline mask data is given for an XBM image, - and the XBM image comes from a file, XEmacs will look for a mask file - with the same name as the image file but with \"Mask\" or \"msk\" - appended. For example, if you specify the XBM file \"left_ptr\" - [usually located in \"/usr/include/X11/bitmaps\"], the associated - mask file \"left_ptrmsk\" will automatically be picked up. -:hotspot-x -:hotspot-y - For `xbm' and `xface'. These keywords specify a hotspot if the image - is instantiated as a `pointer'. Note that if the XBM image file - specifies a hotspot, it will automatically be picked up if no - explicit hotspot is given. -:color-symbols - Only for `xpm'. This specifies an alist that maps strings - that specify symbolic color names to the actual color to be used - for that symbolic color (in the form of a string or a color-specifier - object). If this is not specified, the contents of `xpm-color-symbols' - are used to generate the alist. -:resource-id - Only for `mswindows-resource'. This must be either an integer (which - directly specifies a resource number) or a string. Valid strings are - - -- For bitmaps: - - \"close\", \"uparrow\", \"dnarrow\", \"rgarrow\", \"lfarrow\", - \"reduce\", \"zoom\", \"restore\", \"reduced\", \"zoomd\", - \"restored\", \"uparrowd\", \"dnarrowd\", \"rgarrowd\", \"lfarrowd\", - \"mnarrow\", \"combo\", \"uparrowi\", \"dnarrowi\", \"rgarrowi\", - \"lfarrowi\", \"size\", \"btsize\", \"check\", \"checkboxes\", and - \"btncorners\". - - -- For cursors: - - \"normal\", \"ibeam\", \"wait\", \"cross\", \"up\", \"sizenwse\", - \"sizenesw\", \"sizewe\", \"sizens\", \"sizeall\", and \"no\". - - -- For icons: - - \"sample\", \"hand\", \"ques\", \"bang\", \"note\", and \"winlogo\". -:resource-type - Only for `mswindows-resource'. This must be a symbol, either `cursor', - `icon', or `bitmap', specifying the type of resource to be retrieved. -:face - Only for `inherit'. This specifies the face to inherit from. - For widgets this also specifies the face to use for display. It defaults - to gui-element-face. - -Keywords accepted as menu item specs are also accepted by widgets. -These are `:selected', `:active', `:suffix', `:keys', `:style', -`:filter', `:config', `:included', `:key-sequence', `:accelerator', -`:label' and `:callback'. - -If instead of a vector, the instantiator is a string, it will be -converted into a vector by looking it up according to the specs in the -`console-type-image-conversion-list' (q.v.) for the console type of -the domain (usually a window; sometimes a frame or device) over which -the image is being instantiated. - -If the instantiator specifies data from a file, the data will be read -in at the time that the instantiator is added to the image (which may -be well before when the image is actually displayed), and the -instantiator will be converted into one of the inline-data forms, with -the filename retained using a :file keyword. This implies that the -file must exist when the instantiator is added to the image, but does -not need to exist at any other time (e.g. it may safely be a temporary -file). -" +NOTE: These is current debate over whether the creation of a separate +image specifier type makes any sense or whether they should be merged into +glyphs. See the docs for `make-glyph'. + +Pretty much the only reason you might want to create an image specifier +yourself is to do first-hands exploration of the specifier system in the +context of \"images\". Even then you probably want to create a glyph +instead. since with a glyph you can at least display it." (make-specifier-and-init 'image spec-list)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; glyphs ＠＠ -405,7 +179,7 ＠＠ If PROPERTY does not name a built-in property, its value will simply be returned unless it is a specifier object, in which case - it will be instanced using `specifier-instance'. + it will be instantiated using `specifier-instance'. Optional arguments DEFAULT and NO-FALLBACK are the same as in `specifier-instance'." ＠＠ -555,10 +329,9 ＠＠ "Change the image of GLYPH in LOCALE. SPEC should be an instantiator (a string or vector; see - `make-image-specifier' for a description of possible values here), - a list of (possibly tagged) instantiators, an alist of specifications - (each mapping a locale to an instantiator list), or an image specifier - object. + `make-glyph' for a description of possible values here), a list of + (possibly tagged) instantiators, an alist of specifications (each mapping + a locale to an instantiator list), or an image specifier object. If SPEC is an alist, LOCALE must be omitted. If SPEC is a specifier object, LOCALE can be a locale, a locale type, 'all, ＠＠ -669,8 +442,7 ＠＠ \"pixmap\"), but to any graphical element -- a pixmap, a widget, or even a block of text, when used in the places that call for a glyph.) The format of the SPEC-LIST is typically an image instantiator (a -string or a vector; see `make-image-specifier' for a detailed description -of the valid image instantiators), but can also be a list of such +string or a vector; see below), but can also be a list of such instantiators (each one in turn is tried until an image is successfully produced), a cons of a locale (frame, buffer, etc.) and an instantiator, a list of such conses, or any other form accepted by ＠＠ -689,16 +461,23 ＠＠ frame, etc.), and in these cases you do not create your own glyph, but rather modify the existing one. -As well as using SPEC-LIST to initialize the glyph, you can set -specifications using `set-glyph-image'. Note that, due to a possibly -questionable historical design decision, a glyph itself is not -actually a specifier, but rather is an object containing an image -specifier (as well as other, seldom-used properties). Therefore, you -cannot set or access specifications for the glyph's image by directly -using `set-specifier', `specifier-instance' or the like on the glyph; -instead use them on `(glyph-image GLYPH)' or use the convenience -functions `set-glyph-image', `glyph-image-instance', and -`glyph-image'. +Note that a glyph itself is *not* actually a specifier, but rather is an +object containing an image specifier (as well as other, less-used +properties -- `baseline', `contrib-p', and `face'; see +`set-glyph-property'). Therefore, you cannot set or access specifications +for the glyph's image by directly using `set-specifier', +`specifier-instance' or the like on the glyph; instead use them on +`(glyph-image GLYPH)' or use the convenience functions `set-glyph-image', +`glyph-image-instance', and `glyph-image'. (For example, instead of using +SPEC-LIST to initialize the glyph, you can create a blank glyph and then +set specifications using `set-glyph-image'.) + +\[The historical design decision to create a separate image specifier type, +rather than make glyphs themselves be specifiers, is debatable -- the other +properties of glyphs are rarely used and could conceivably have been +incorporated into the glyph's instantiator. The rarely used glyph types +\(buffer, pointer, icon) could also have been incorporated into the +instantiator.] Once you have created a glyph, you specify where it will be used as follows: ＠＠ -734,7 +513,7 ＠＠ value of the variable `toolbar-mail-icon' (in general, `toolbar-*-icon') and then calling `(set-specifier-dirty-flag default-toolbar)'. (#### Unfortunately this doesn't quite work the way it should; the - change will appear in new frames, but not existing ones. + change will appear in new frames, but not existing ones.) -- To insert a glyph into a gutter, create or modify a gutter instantiator (typically set on the specifier `default-gutter'). Gutter instantiators ＠＠ -781,10 +560,12 ＠＠ which controls the appearance of characters. You can also set an overriding display table for use with text displayed in a particular face; see `set-face-display-table' and `make-display-table'. - #### Note: Display tables do not currently support general Mule - characters. They will be overhauled at some point to support this - and to provide other features required under Mule. +-- To use a glyph to control the appearance of a button widget, specify it + as the value of the :image property in a button instantiator. (You can + also give a symbol that evaluates to a glyph, or an instantiator. This + is somewhat similar to the way that toolbar work -- see above.) + -- To use a glyph as the background pixmap of a face: Note that the background pixmap of a face is actually an image specifier -- probably the only place in XEmacs where an image specifier occurs outside of ＠＠ -796,14 +577,271 ＠＠ image and the foreground and background of the image get filled in with the corresponding colors from the face. + +Image instantiators come in many formats: `xbm', `xpm', `gif', `jpeg', +etc. This describes the format of the data describing the image. The +resulting image instances also come in many types -- `mono-pixmap', +`color-pixmap', `text', `pointer', etc. This refers to the behavior of +the image and the sorts of places it can appear. (For example, a +color-pixmap image has fixed colors specified for it, while a +mono-pixmap image comes in two unspecified shades \"foreground\" and +\"background\" that are determined from the face of the glyph or +surrounding text; a text image appears as a string of text and has an +unspecified foreground, background, and font; a pointer image behaves +like a mono-pixmap image but can only be used as a mouse pointer +\[mono-pixmap images cannot be used as mouse pointers]; etc.) It is +important to keep the distinction between image instantiator format and +image instance type in mind. Typically, a given image instantiator +format can result in many different image instance types (for example, +`xpm' can be instantiated as `color-pixmap', `mono-pixmap', or `pointer'; +whereas `cursor-font' can be instantiated only as `pointer'), and a +particular image instance type can be generated by many different +image instantiator formats (e.g. `color-pixmap' can be generated by `xpm', +`gif', `jpeg', etc.). + +See `make-image-instance' for a more detailed discussion of image instance +types. + +An image instantiator should be a string or a vector of the form + + [FORMAT :KEYWORD VALUE ...] + +i.e. a format symbol followed by zero or more alternating keyword-value +pairs. FORMAT should be one of + +'nothing + Don't display anything; no keywords are valid for this. + Can only be instantiated as `nothing'. +'string + Display this image as a text string. Can only be instantiated + as `text', although support for instancing as `mono-pixmap' + and `color-pixmap' should be added. +'formatted-string + Display this image as a text string, with replaceable fields; + not currently implemented. (It is, instead, equivalent to `string'.) +'xbm + An X bitmap; only if X or MS Windows support was compiled into this + XEmacs. Can be instantiated as `mono-pixmap', `color-pixmap', or `pointer'. +'xpm + An XPM pixmap; only if XPM support was compiled into this XEmacs. + Can be instantiated as `color-pixmap', `mono-pixmap', or `pointer'. +'xface + An X-Face bitmap, used to encode people's faces in e-mail messages; + only if X-Face support was compiled into this XEmacs. Can be + instantiated as `mono-pixmap', `color-pixmap', or `pointer'. +'gif + A GIF87 or GIF89 image; only if GIF support was compiled into this + XEmacs. NOTE: only the first frame of animated gifs will be displayed. + Can be instantiated as `color-pixmap'. +'jpeg + A JPEG image; only if JPEG support was compiled into this XEmacs. + Can be instantiated as `color-pixmap'. +'png + A PNG image; only if PNG support was compiled into this XEmacs. + Can be instantiated as `color-pixmap'. +'tiff + A TIFF image; only if TIFF support was compiled into this XEmacs. + Can be instantiated as `color-pixmap'. +'bmp + A MS Windows BMP image; only if MS Windows support was compiled into + this XEmacs. Can be instantiated as `color-pixmap'. +'cursor-font + One of the standard cursor-font names, such as \"watch\" or + \"right_ptr\" under X. Under X, this is, more specifically, any + of the standard cursor names from appendix B of the Xlib manual + [also known as the file <X11/cursorfont.h>] minus the XC_ prefix. + On other window systems, the valid names will be specific to the + type of window system. Can only be instantiated as `pointer'. +'mswindows-resource + An MS Windows pointer resource. Specifies a resource to retrieve + directly from the system (an OEM resource) or from a file, particularly + an executable file. If the resource is to be retrieved from a file, use + :file and optionally :resource-id. Otherwise use :resource-id. Always + specify :resource-type to specify the type (cursor, bitmap or icon) of + the resource. Possible values for :resource-id are listed below. Can + be instantiated as `pointer' or `color-pixmap'. +'font + A glyph from a font; i.e. the name of a font, and glyph index into it + of the form \"FONT fontname index [[mask-font] mask-index]\". + Currently can only be instantiated as `pointer', although this should + probably be fixed. +'subwindow + An embedded windowing system window. The creation, size, location, and + visibility of the subwindow are under the control of XEmacs, but the + drawing of the contents is meant to be handled by another program. The + primitive `image-instance-subwindow-id' returns the internal + window-system ID of the subwindow, which you can pass to another + program. #### We need to implement some protocol for communication + between the two; doesn't yet exist. Subwindows could form a basis for + an implementation of OLE/COM, which allows for objects of one app to be + embedded in another. (For example, a mini spreadsheet inside of a larger + Word document -- when you move the cursor into the spreadsheet, the menu + changes and suddenly you're \"in\" Excel, editing the spreadsheet. + Likewise, when you print, presumably Word handles everything, but heaves + a blank splot for the spreadsheet, which Excel then prints. OLE is very + tricky, as you can imagine.) Subwindows can only be instantiated as + `subwindow'. +'button + A button widget; either a push button, radio button or toggle button. + Can only be instantiated as `widget'. +'combo-box + A drop list of selectable items in a widget, for editing text. + Can only be instantiated as `widget'. +'edit-field + A text editing widget. Can only be instantiated as `widget'. +'label + A static, text-only, widget; for displaying text. Can only be instantiated + as `widget'. +'layout + A widget for controlling the positioning of children underneath it. + Through the use of nested layouts, a widget hierarchy can be created + which can have the appearance of any standard dialog box or similar + arrangement; all of this is counted as one \"glyph\" and could appear + in many of the places that expect a single glyph. Can only be instantiated + as `widget'. +'native-layout + The native version of a layout widget. #### Document me better! + Can only be instantiated as `widget'. +'progress-gauge + A sliding widget, for showing progress. Can only be instantiated as + `widget'. +'tab-control + A tab widget; a series of user selectable tabs. Can only be instantiated + as `widget'. +'tree-view + A folding widget. Can only be instantiated as `widget'. +'scrollbar + A scrollbar widget. Can only be instantiated as `widget'. +'autodetect + XEmacs tries to guess what format the data is in. If X support + exists, the data string will be checked to see if it names a filename. + If so, and this filename contains XBM or XPM data, the appropriate + sort of pixmap or pointer will be created. [This includes picking up + any specified hotspot or associated mask file.] Otherwise, if `pointer' + is one of the allowable image-instance types and the string names a + valid cursor-font name, the image will be created as a pointer. + Otherwise, the image will be displayed as text. If no X support + exists, the image will always be displayed as text. Can be instantiated as + `mono-pixmap', `color-pixmap', `pointer', or `text'. +'inherit + Inherit from the background-pixmap property of a face. Can only be + instantiated as `mono-pixmap'. + +The valid keywords are: + +:data + Inline data. For most formats above, this should be a string. For + XBM images, this should be a list of three elements: width, height, and + a string of bit data. This keyword is valid for all of the bitmap/pixmap + formats, as well as `string', `formatted-string', `font', `cursor-font', + and `autodetect'. +:file + Data is contained in a file. The value is the name of this file. + If both :data and :file are specified, the image is created from + what is specified in :data and the string in :file becomes the + value of the `image-instance-file-name' function when applied to + the resulting image-instance. This keyword is valid for all of the + bitmap/pixmap formats as well as `mswindows-resource'. +:foreground +:background + For `xbm', `xface', `cursor-font', `widget' and `font'. These keywords + allow you to explicitly specify foreground and background colors. + The argument should be anything acceptable to `make-color-instance'. + This will cause what would be a `mono-pixmap' to instead be colorized + as a two-color color-pixmap, and specifies the foreground and/or + background colors for a pointer instead of black and white. +:mask-data + For `xbm' and `xface'. This specifies a mask to be used with the + bitmap. The format is a list of width, height, and bits, like for + :data. +:mask-file + For `xbm' and `xface'. This specifies a file containing the mask data. + If neither a mask file nor inline mask data is given for an XBM image, + and the XBM image comes from a file, XEmacs will look for a mask file + with the same name as the image file but with \"Mask\" or \"msk\" + appended. For example, if you specify the XBM file \"left_ptr\" + [usually located in \"/usr/include/X11/bitmaps\"], the associated + mask file \"left_ptrmsk\" will automatically be picked up. +:hotspot-x +:hotspot-y + For `xbm' and `xface'. These keywords specify a hotspot if the image + is instantiated as a `pointer'. Note that if the XBM image file + specifies a hotspot, it will automatically be picked up if no + explicit hotspot is given. +:color-symbols + Only for `xpm'. This specifies an alist that maps strings + that specify symbolic color names to the actual color to be used + for that symbolic color (in the form of a string or a color-specifier + object). If this is not specified, the contents of `xpm-color-symbols' + are used to generate the alist. +:resource-id + Only for `mswindows-resource'. This must be either an integer (which + directly specifies a resource number) or a string. Valid strings are + + -- For bitmaps: + + \"close\", \"uparrow\", \"dnarrow\", \"rgarrow\", \"lfarrow\", + \"reduce\", \"zoom\", \"restore\", \"reduced\", \"zoomd\", + \"restored\", \"uparrowd\", \"dnarrowd\", \"rgarrowd\", \"lfarrowd\", + \"mnarrow\", \"combo\", \"uparrowi\", \"dnarrowi\", \"rgarrowi\", + \"lfarrowi\", \"size\", \"btsize\", \"check\", \"checkboxes\", and + \"btncorners\". + + -- For cursors: + + \"normal\", \"ibeam\", \"wait\", \"cross\", \"up\", \"sizenwse\", + \"sizenesw\", \"sizewe\", \"sizens\", \"sizeall\", and \"no\". + + -- For icons: + + \"sample\", \"hand\", \"ques\", \"bang\", \"note\", and \"winlogo\". +:resource-type + Only for `mswindows-resource'. This must be a symbol, either `cursor', + `icon', or `bitmap', specifying the type of resource to be retrieved. +:face + Only for `inherit'. This specifies the face to inherit from. + For widgets this also specifies the face to use for display. It defaults + to gui-element-face. + +Keywords accepted as menu item specs are also accepted by widgets. +These are `:selected', `:active', `:suffix', `:keys', `:style', +`:filter', `:config', `:included', `:key-sequence', `:accelerator', +`:label' and `:callback'. + +Note that the callback of a widget should usually be written as an +interactive function with an interactive spec of (interactive \"e\"), and a +single `event' argument. The event will be an activate event, describing +the user action (e.g. click on a button) that trigged the callback. The +widget itself that was activated is described by an image instance, +retrievable from the event using `event-image-instance'. Handling the +action may involve setting properties on the image instance or other image +instances in the dialog box in which the widget is usually contained; see +`make-image-instance' for more information. + +If instead of a vector, the instantiator is a string, it will be +converted into a vector by looking it up according to the specs in the +`console-type-image-conversion-list' (q.v.) for the console type of +the domain (usually a window; sometimes a frame or device) over which +the image is being instantiated. + +If the instantiator specifies data from a file, the data will be read +in at the time that the instantiator is added to the image (which may +be well before when the image is actually displayed), and the +instantiator will be converted into one of the inline-data forms, with +the filename retained using a :file keyword. This implies that the +file must exist when the instantiator is added to the image, but does +not need to exist at any other time (e.g. it may safely be a temporary +file). + It is extremely rare that you will ever have to specify a value for TYPE, -which should be one of `buffer' (used for glyphs in an extent, the modeline, -the toolbar, or elsewhere in a buffer), `pointer' (used for the mouse-pointer), -or `icon' (used for a frame's icon), and defaults to `buffer'. The only cases -where it needs to be specified is when creating icon or pointer glyphs, and -in both cases the necessary glyphs have already been created at startup and -are accessed through the appropriate variables, e.g. `text-pointer-glyph' -(or in general, `*-pointer-glyph') and `frame-icon-glyph'." +which should be one of `buffer' (used for glyphs in an extent, the +modeline, the toolbar, or elsewhere in a buffer), `pointer' (used for the +mouse-pointer), or `icon' (used for a frame's icon), and defaults to +`buffer'. The only cases where it needs to be specified is when creating +icon or pointer glyphs, and in both cases the necessary glyphs have already +been created at startup and are accessed through the appropriate variables, +e.g. `text-pointer-glyph' (or in general, `*-pointer-glyph') and +`frame-icon-glyph'." (let ((glyph (make-glyph-internal type))) (and spec-list (set-glyph-image glyph spec-list)) glyph)) ＠＠ -870,6 +908,37 ＠＠ "Return t if OBJECT is an image instance of type `subwindow'." (and (image-instance-p object) (eq 'subwindow (image-instance-type object)))) +(defun image-instance-property (image-instance property &optional default) + "Return the given property of the given image instance. +Returns DEFAULT if the property or the property method do not exist for +the image instance in the domain." + (check-argument-type 'image-instance-p image-instance) + (get image-instance property default)) + +(defun set-image-instance-property (image-instance prop value) + "Set the property PROP on IMAGE-INSTANCE to VALUE. +Only certain properties of the image instance can be changed, and they +represent \"temporary\" changes. If you want to make permanent changes, +you need to change the instantiator that generated the instance -- +retrieve the instantiator with `image-instance-instantiator', and change +its properties with `set-instantiator-property'. + +This applies mostly to widgets. For example, you can set a property on +a widget image instance to change the state of a radio or checkbox button, +set the text currently in an edit field, etc. However, those changes apply +only to the *currently* displayed widgets. If these widgets are in a dialog +box, and you want to change the way the widgets in the dialog box appear +*each* time the dialog box is displayed, you need to change the instantiator. + +Make sure you understand the difference between instantiators and +instances. An \"instantiator\" is a specification, indicating how to +determine the value of a setting whose value can vary in different +circumstances or \"locales\" (buffers, frames, etc.). An \"instance\" is the +resulting value in a particular circumstance. For more information, see +`make-specifier'." + (check-argument-type 'image-instance-p image-instance) + (put image-instance prop value)) + ;;;;;;;;;; the built-in glyphs (defvar text-pointer-glyph (make-pointer-glyph) ＠＠ -1000,10 +1069,6 ＠＠ ;;; (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 () 1.8.12.1 +6 -5 XEmacs/xemacs/lisp/gui.el Index: gui.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/gui.el,v retrieving revision 1.8 retrieving revision 1.8.12.1 diff -u -r1.8 -r1.8.12.1 --- gui.el 2002/03/15 07:43:19 1.8 +++ gui.el 2005/02/16 00:40:39 1.8.12.1 ＠＠ -1,7 +1,7 ＠＠ ;;; gui.el --- Basic GUI functions for XEmacs. ;; Copyright (C) 1997 Free Software Foundation, Inc. -;; Copyright (C) 1996 Ben Wing +;; Copyright (C) 1996, 2002 Ben Wing ;; Maintainer: XEmacs Development Team ;; Keywords: internal, dumped ＠＠ -107,10 +107,11 ＠＠ (vector 'button :descriptor string :face 'gui-button-face - :callback-ex `(lambda (image-instance event) - (gui-button-action image-instance - (quote ,action) - (quote ,user-data))))) + :callback `(lambda (event) + (interactive "e") + (gui-button-action (event-image-instance event) + (quote ,action) + (quote ,user-data))))) (defun insert-gui-button (button &optional pos buffer) "Insert GUI button BUTTON at POS in BUFFER." 1.44.4.1 +9 -2 XEmacs/xemacs/lisp/help.el Index: help.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/help.el,v retrieving revision 1.44 retrieving revision 1.44.4.1 diff -u -r1.44 -r1.44.4.1 --- help.el 2005/01/31 20:08:45 1.44 +++ help.el 2005/02/16 00:40:39 1.44.4.1 ＠＠ -1061,6 +1061,8 ＠＠ (setq obj (read (current-buffer))) (and (symbolp obj) (fboundp obj) obj))))))) +(make-obsolete 'function-called-at-point 'function-at-point) + (defun function-at-event (event) "Return the function whose name is around the position of EVENT. EVENT should be a mouse event. When calling from a popup or context menu, ＠＠ -1389,13 +1391,18 ＠＠ (an-p "an ") (t "a ")) "%s" - (if macro-p " macro" " function"))) + (cond ((eq macro-p 'special-form) + " special form") + (macro-p " macro") + (t " function")))) string))))) (cond ((or (stringp def) (vectorp def)) (princ "a keyboard macro.") (setq kbd-macro-p t)) ((subrp fndef) - (funcall int "built-in" nil macrop)) + (if (string-match "#<special-form" (prin1-to-string fndef)) + (funcall int "built-in" nil 'special-form) + (funcall int "built-in" nil macrop))) ((compiled-function-p fndef) (funcall int "compiled Lisp" nil macrop)) ((eq (car-safe fndef) 'lambda) 1.34.4.1 +7 -1 XEmacs/xemacs/lisp/info.el Index: info.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/info.el,v retrieving revision 1.34 retrieving revision 1.34.4.1 diff -u -r1.34 -r1.34.4.1 --- info.el 2004/12/06 03:51:21 1.34 +++ info.el 2005/02/16 00:40:40 1.34.4.1 ＠＠ -433,7 +433,7 ＠＠ (defconst Info-emacs-info-file-name "xemacs.info" "The filename of the XEmacs info for `Info-goto-emacs-command-node' -(`\\<help-mode-map>\\[Info-goto-emacs-command-node]')") +\(`\\<help-mode-map>\\[Info-goto-emacs-command-node]')") ;;;###autoload (defvar Info-directory-list nil ＠＠ -449,6 +449,12 ＠＠ from .emacs. For instance: (setq Info-directory-list (cons \"~/info\" Info-directory-list))") + +(defvar Info-default-directory-list nil + "This used to be the initial value of Info-directory-list. +If you want to change the locations where XEmacs looks for info files, +set Info-directory-list.") +(make-obsolete-variable 'Info-default-directory-list 'Info-directory-list) ;; This could as well be hard-coded since ${srcdir}/info/dir is in CVS --dv (defconst Info-localdir-heading-regexp "^Local Packages:$" 1.11.6.1 +13 -0 XEmacs/xemacs/lisp/keymap.el Index: keymap.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/keymap.el,v retrieving revision 1.11 retrieving revision 1.11.6.1 diff -u -r1.11 -r1.11.6.1 --- keymap.el 2003/03/02 09:38:39 1.11 +++ keymap.el 2005/02/16 00:40:40 1.11.6.1 ＠＠ -527,4 +527,17 ＠＠ (define-key function-key-map [?\C-x ?＠ ?a] 'event-apply-alt-modifier) (define-key function-key-map [?\C-x ?＠ ?k] 'synthesize-keysym)))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;; keymap obsoleteness + +(defun keymap-parent (keymap) + "Return the first parent of the given keymap." + (car (keymap-parents keymap))) +(make-compatible 'keymap-parent 'keymap-parents) + +(defun set-keymap-parent (keymap parent) + "Make the given keymap have (only) the given parent." + (set-keymap-parents keymap (if parent (list parent) '())) + parent) +(make-compatible 'set-keymap-parent 'set-keymap-parents) + ;;; keymap.el ends here 1.12.4.1 +16 -0 XEmacs/xemacs/lisp/menubar.el Index: menubar.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/menubar.el,v retrieving revision 1.12 retrieving revision 1.12.4.1 diff -u -r1.12 -r1.12.4.1 --- menubar.el 2005/02/07 19:30:08 1.12 +++ menubar.el 2005/02/16 00:40:41 1.12.4.1 ＠＠ -885,6 +885,22 ＠＠ (define-key menu-accelerator-map [kp-enter] 'menu-select) (define-key menu-accelerator-map "\C-g" 'menu-quit))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;; menu obsoleteness + +(defun add-menu-item (menu-path item-name function enabled-p &optional before) + "Obsolete. See the function `add-menu-button'." + (or item-name (error "must specify an item name")) + (add-menu-button menu-path (vector item-name function enabled-p) before)) +(make-obsolete 'add-menu-item 'add-menu-button) + +(defun add-menu (menu-path menu-name menu-items &optional before) + "See the function `add-submenu'." + (or menu-name (error "must specify a menu name")) + (or menu-items (error "must specify some menu items")) + (add-submenu menu-path (cons menu-name menu-items) before)) +;; Can't make this obsolete. easymenu depends on it. +(make-compatible 'add-menu 'add-submenu) +  (provide 'menubar) 1.27.4.1 +6 -0 XEmacs/xemacs/lisp/minibuf.el Index: minibuf.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/minibuf.el,v retrieving revision 1.27 retrieving revision 1.27.4.1 diff -u -r1.27 -r1.27.4.1 --- minibuf.el 2005/01/28 02:58:40 1.27 +++ minibuf.el 2005/02/16 00:40:41 1.27.4.1 ＠＠ -2245,4 +2245,10 ＠＠ (button-release-event-p last-command-event) (misc-user-event-p last-command-event)))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;; minibuffer obsoleteness + +(define-compatible-function-alias 'read-minibuffer + 'read-expression) ; misleading name +(define-compatible-function-alias 'read-input 'read-string) + ;;; minibuf.el ends here 1.23.12.1 +17 -0 XEmacs/xemacs/lisp/modeline.el Index: modeline.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/modeline.el,v retrieving revision 1.23 retrieving revision 1.23.12.1 diff -u -r1.23 -r1.23.12.1 --- modeline.el 2002/03/13 08:52:07 1.23 +++ modeline.el 2005/02/16 00:40:41 1.23.12.1 ＠＠ -866,4 +866,21 ＠＠ (cons modeline-process-extent 'modeline-process) ")%]%-")) +;;;;;;;;;;;;;;;;;;;;;;;;;;;; modeline obsoleteness + +(define-compatible-function-alias 'redraw-mode-line 'redraw-modeline) +(define-compatible-function-alias 'force-mode-line-update + 'redraw-modeline) ;; FSF compatibility +(define-compatible-variable-alias 'mode-line-map 'modeline-map) +(define-compatible-variable-alias 'mode-line-buffer-identification + 'modeline-buffer-identification) +(define-compatible-variable-alias 'mode-line-process 'modeline-process) +(define-compatible-variable-alias 'mode-line-modified 'modeline-modified) +(make-compatible-variable 'mode-line-inverse-video + "use set-face-highlight-p and set-face-reverse-p") +(define-compatible-variable-alias 'default-mode-line-format + 'default-modeline-format) +(define-compatible-variable-alias 'mode-line-format 'modeline-format) +(define-compatible-variable-alias 'mode-line-menu 'modeline-menu) + ;;; modeline.el ends here 1.31.4.1 +17 -2 XEmacs/xemacs/lisp/mouse.el Index: mouse.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/mouse.el,v retrieving revision 1.31 retrieving revision 1.31.4.1 diff -u -r1.31 -r1.31.4.1 --- mouse.el 2005/01/26 04:47:14 1.31 +++ mouse.el 2005/02/16 00:40:42 1.31.4.1 ＠＠ -776,8 +776,9 ＠＠ overriding-hooks event mouse-track-click-count))) ((or (key-press-event-p event) - (and (misc-user-event-p event) - (eq (event-function event) 'cancel-mode-internal))) + (and (notify-event-p event) + (eq (event-subtype event) + 'notify-cancel-mouse-selection))) (error "Selection aborted")) (t (dispatch-event event)))) ＠＠ -1804,5 +1805,19 ＠＠ (setq vertical-divider-map (make-keymap)) (define-key vertical-divider-map 'button1 'drag-window-divider) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;; mouse obsoleteness + +;;; (defun mouse-eval-last-sexpr (event) +;;; (interactive "＠e") +;;; (save-excursion +;;; (mouse-set-point event) +;;; (eval-last-sexp nil))) + +(define-obsolete-function-alias 'mouse-eval-last-sexpr 'mouse-eval-sexp) + +(defun read-mouse-position (frame) + (cdr (mouse-position (frame-device frame)))) +(make-obsolete 'read-mouse-position 'mouse-position) ;;; mouse.el ends here 1.5.24.1 +16 -1 XEmacs/xemacs/lisp/objects.el Index: objects.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/objects.el,v retrieving revision 1.5 retrieving revision 1.5.24.1 diff -u -r1.5 -r1.5.24.1 --- objects.el 2001/04/12 18:21:32 1.5 +++ objects.el 2005/02/16 00:40:42 1.5.24.1 ＠＠ -1,7 +1,7 ＠＠ ;;; objects.el --- Lisp interface to C window-system objects ;; Copyright (C) 1994, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1995 Ben Wing +;; Copyright (C) 1995, 2005 Ben Wing ;; Author: Chuck Thompson <cthomp(a)xemacs.org&gt; ;; Author: Ben Wing <ben(a)xemacs.org&gt; ＠＠ -191,5 +191,20 ＠＠ the instantiator would not be valid), and optionally a value which, if non-nil, means to invert the sense of the inherited property." (make-specifier-and-init 'color spec-list)) + +;;;;;;;;;;;;;; obsoleteness + +(defun x-color-values (color &optional frame) + "Return a description of the color named COLOR on frame FRAME. +The value is a list of integer RGB values--(RED GREEN BLUE). +These values appear to range from 0 to 65280 or 65535, depending +on the system; white is (65280 65280 65280) or (65535 65535 65535). +If FRAME is omitted or nil, use the selected frame." + (color-instance-rgb-components (make-color-instance color))) +(make-compatible 'x-color-values 'color-instance-rgb-components) + +(make-obsolete 'mswindows-color-list 'color-list) +(make-obsolete 'tty-color-list 'color-list) +(make-compatible 'list-fonts 'font-list) ;;; objects.el ends here. 1.18.4.1 +0 -389 XEmacs/xemacs/lisp/obsolete.el <<Binary file>> 1.23.6.1 +6 -0 XEmacs/xemacs/lisp/package-ui.el Index: package-ui.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/package-ui.el,v retrieving revision 1.23 retrieving revision 1.23.6.1 diff -u -r1.23 -r1.23.6.1 --- package-ui.el 2004/11/04 23:05:55 1.23 +++ package-ui.el 2005/02/16 00:40:43 1.23.6.1 ＠＠ -686,6 +686,12 ＠＠ ;;;###autoload (defalias 'list-packages 'pui-list-packages) +(define-obsolete-function-alias 'pui-add-install-directory + 'pui-set-local-package-get-directory) ; misleading name + +(define-obsolete-function-alias 'package-get-download-menu + 'package-ui-download-menu) + (provide 'package-ui) ;;; package-ui.el ends here 1.9.16.1 +199 -6 XEmacs/xemacs/lisp/scrollbar.el Index: scrollbar.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/scrollbar.el,v retrieving revision 1.9 retrieving revision 1.9.16.1 diff -u -r1.9 -r1.9.16.1 --- scrollbar.el 2001/05/04 22:42:13 1.9 +++ scrollbar.el 2005/02/16 00:40:43 1.9.16.1 ＠＠ -1,6 +1,7 ＠＠ ;;; scrollbar.el --- Scrollbar support for XEmacs ;; Copyright (C) 1995, 1997 Free Software Foundation, Inc. +;; Copyright (C) 2002 Ben Wing. ;; Maintainer: XEmacs Development Team ;; Keywords: internal, extensions, dumped ＠＠ -52,15 +53,58 ＠＠ (declare-fboundp (mswindows-init-scrollbar-metrics locale)))) ;; -;; vertical scrollbar functions +;; vertical and horizontal scrollbar functions;; converted from the C code ;; -;;; #### Move functions from C into Lisp here! +;; If the original point is still visible, put the cursor back there. +;; Otherwise, when scrolling down stick it at the beginning of the +;; first visible line and when scrolling up stick it at the beginning +;; of the last visible line. + +(defun scrollbar-reset-cursor (win orig-pt) + ;; When this function is called we know that start is already + ;; accurate. We know this because either set-window-start or + ;; recenter was called immediately prior to it being called. + (let ((start-pos (window-start win)) + (selected (eq win (selected-window (frame-device (window-frame win))))) + (buf (window-buffer win))) + (when buf ;; make sure window not deleted out from under us + (cond ((< orig-pt start-pos) + (if selected + (goto-char start-pos buf) + (set-window-point win start-pos))) + ((not (pos-visible-in-window-p orig-pt win)) + (move-to-window-line -1 win) + (if selected + (beginning-of-line nil buf) + (set-window-point win (point-at-bol nil buf)))) + (t + (if selected + (goto-char orig-pt buf) + (set-window-point win orig-pt))))))) + +(defun scrollbar-line-up (window) + "Function called when the line-up arrow on the scrollbar is clicked. +This is the little arrow at the top of the scrollbar. One argument, the +scrollbar's window. You can advise this function to change the scrollbar +behavior." + (condition-case nil + (scroll-down 1 window) + (error nil)) + (setq zmacs-region-stays t) + nil) + +(defun scrollbar-line-down (window) + "Function called when the line-down arrow on the scrollbar is clicked. +This is the little arrow at the bottom of the scrollbar. One argument, the +scrollbar's window. You can advise this function to change the scrollbar +behavior." + (condition-case nil + (scroll-up 1 window) + (error nil)) + (setq zmacs-region-stays t) + nil) -;; -;; horizontal scrollbar functions -;; - (defun scrollbar-char-left (window) "Function called when the char-left arrow on the scrollbar is clicked. This is the little arrow to the left of the scrollbar. One argument is ＠＠ -81,6 +125,60 ＠＠ (setq zmacs-region-stays t) nil)) +(defun scrollbar-page-up (object) + "Function called when the user gives the \"page-up\" scrollbar action. +\(The way this is done can vary from scrollbar to scrollbar.) One argument, +a cons containing the scrollbar's window and a value (#### document me! +This value is nil for Motif/Lucid scrollbars and a number for Athena +scrollbars). You can advise this function to change the scrollbar +behavior." + (let ((window (car object))) + (if (null (cdr object)) + ;; Motif and Athena scrollbars behave differently, but in accordance + ;; with their standard behaviors. It is not possible to hide the + ;; differences down in lwlib because knowledge of XEmacs buffer and + ;; cursor motion routines is necessary. + (condition-case nil + (scroll-down nil window) + (error nil)) + (let ((value (cdr object))) + (move-to-window-line 0 window) + (if (eq window (selected-window)) + ;; this rather awkward code emulates what the C code did + ;; (rather more cleanly), given the awkwardness of + ;; `vertical-motion'. + (let ((p (window-point window))) + (with-current-buffer (window-buffer window) + (save-excursion + (goto-char p) + (vertical-motion value window) + (set-window-point window (point))))) + (vertical-motion value window)) + (center-to-window-line 0 window)))) + (setq zmacs-region-stays t) + nil) + +(defun scrollbar-page-down (object) + "Function called when the user gives the \"page-down\" scrollbar action. +\(The way this is done can vary from scrollbar to scrollbar.) One argument, +a cons containing the scrollbar's window and a value (#### document me! +This value is nil for Motif/Lucid scrollbars and a number for Athena +scrollbars). You can advise this function to change the scrollbar +behavior." + (let ((window (car object))) + ;; Motif and Athena scrollbars behave differently, but in accordance + ;; with their standard behaviors. It is not possible to hide the + ;; differences down in lwlib because knowledge of XEmacs buffer and + ;; cursor motion routines is necessary. + (if (null (cdr object)) + (condition-case nil + (scroll-up nil window) + (error nil)) + (move-to-window-line (cdr object) window) + (center-to-window-line 0 window))) + (setq zmacs-region-stays t) + nil) + (defun scrollbar-page-left (window) "Function called when the user gives the \"page-left\" scrollbar action. \(The way this is done can vary from scrollbar to scrollbar.\) One argument is ＠＠ -103,6 +201,32 ＠＠ (setq zmacs-region-stays t) nil)) +(defun scrollbar-to-top (window) + "Function called when the user invokes the \"to-top\" scrollbar action. +The way this is done can vary from scrollbar to scrollbar, but +C-button1 on the up-arrow is very common. One argument, the +scrollbar's window. You can advise this function to change the +scrollbar behavior." + (let ((orig-pt (window-point window))) + (set-window-point window (point-min (window-buffer window))) + (center-to-window-line 0 window) + (scrollbar-reset-cursor window orig-pt)) + (setq zmacs-region-stays t) + nil) + +(defun scrollbar-to-bottom (window) + "Function called when the user invokes the \"to-bottom\" scrollbar action. +The way this is done can vary from scrollbar to scrollbar, but +C-button1 on the down-arrow is very common. One argument, the +scrollbar's window. You can advise this function to change the +scrollbar behavior." + (let ((orig-pt (window-point window))) + (set-window-point window (point-max (window-buffer window))) + (center-to-window-line -3 window) + (scrollbar-reset-cursor window orig-pt)) + (setq zmacs-region-stays t) + nil) + (defun scrollbar-to-left (window) "Function called when the user gives the \"to-left\" scrollbar action. \(The way this is done can vary from scrollbar to scrollbar.\). One argument is ＠＠ -134,5 +258,74 ＠＠ (scrollbar-set-hscroll window value) (setq zmacs-region-stays t) nil))) + +(defun scrollbar-vertical-drag (object) + "Function called when the user drags the vertical scrollbar slider. +One argument, a cons containing the scrollbar's window and a value +between point-min and point-max. You can advise this function to +change the scrollbar behavior." + (flet ((scrollbar-point (win) + ;; Return beginning point of line which + ;; (window-scrollbar-point-marker win) lies on. Copied from the + ;; C code, which has lots of extra checks. + (let ((buf (window-buffer win))) + (cond ((not buf) ;; non-leaf window + 0) + ((not (buffer-live-p buf)) + (window-start win)) + (t (with-current-buffer buf + (save-excursion + (goto-char (marker-position + (window-scrollbar-point-marker win))) + (point-at-bol)))))))) + (let* ((window (car object)) + (orig-pt (window-point window))) + (set-marker (window-scrollbar-point-marker window) (cdr object) + (window-buffer window)) + (set-window-start window (scrollbar-point window) nil) + (scrollbar-reset-cursor window orig-pt) + (sit-for 0))) + (setq zmacs-region-stays t) + nil) + +(defun scrollbar-set-hscroll (window value) + "Set WINDOW's hscroll position to VALUE. +This ensures that VALUE is in the proper range for the horizontal scrollbar." + (unless (eq value 'max) + (check-argument-type 'integerp value)) + (let* ((wcw (1- (window-width window))) + ;; #### We should be able to scroll further right as long as there is + ;;a visible truncation glyph. This calculation for max is bogus. + (max-len (+ (window-maximum-line-width window) 2)) + (hscroll (if (or (eq value 'max) (> value (- max-len wcw))) + (- max-len wcw) value)) + ;; Can't allow this out of set-window-hscroll's acceptable range. + (hscroll (max 0 hscroll)) + ;; INCREDIBLY bogus code here removed; apparently `hscroll' was + ;; once declared as `short' in the struct window. but comment is + ;; too good to just delete. --ben + ;; #### What hell on the earth this code limits scroll size to the + ;; machine-dependent SHORT size? -- kkm + ;; (hscroll (min (1- (lsh 1 (1- SHORTBITS))) hscroll)) + ) + (unless (= hscroll (window-hscroll window)) + (set-window-hscroll window hscroll))) + nil) + +(defun default-scrollbar-event-handler (event) + "For use as the value of `scrollbar-event-handler'. +This implements standard scrollbar behavior, with the help of the other +functions in scrollbar.el." + (let ((fun (event-subtype event)) + (obj (event-window event))) + (if (memq fun '(scrollbar-page-up + scrollbar-page-down + scrollbar-vertical-drag scrollbar-horizontal-drag)) + (setq obj (cons obj (event-scrollbar-value event)))) + (funcall fun obj)) + nil) + +(setq scrollbar-event-handler 'default-scrollbar-event-handler) + ;;; scrollbar.el ends here 1.53.4.1 +10 -0 XEmacs/xemacs/lisp/startup.el Index: startup.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/startup.el,v retrieving revision 1.53 retrieving revision 1.53.4.1 diff -u -r1.53 -r1.53.4.1 --- startup.el 2005/01/26 04:56:18 1.53 +++ startup.el 2005/02/16 00:40:43 1.53.4.1 ＠＠ -220,6 +220,16 ＠＠ This will be true when `after-init-hook' is run and at all times after, and will not be true at any time before.") +(defvar Info-default-directory-list nil + "This used to be the initial value of Info-directory-list. +If you want to change the locations where XEmacs looks for info files, +set Info-directory-list.") +(make-obsolete-variable 'Info-default-directory-list 'Info-directory-list) + +(defvar init-file-user nil + "This used to be the name of the user whose init file was read at startup.") +(make-obsolete-variable 'init-file-user 'load-user-init-file-p) + (defvar initial-frame-unmapped-p nil)  1.36.4.1 +271 -140 XEmacs/xemacs/lisp/subr.el Index: subr.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/subr.el,v retrieving revision 1.36 retrieving revision 1.36.4.1 diff -u -r1.36 -r1.36.4.1 --- subr.el 2005/01/28 02:05:05 1.36 +++ subr.el 2005/02/16 00:40:44 1.36.4.1 ＠＠ -68,7 +68,9 ＠＠ (setq macro-declaration-function 'macro-declaration-function)  -;;;; Lisp language features. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Lisp language features ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defmacro lambda (&rest cdr) "Return a lambda expression. ＠＠ -178,23 +180,21 ＠＠ list)  -;;;; Keymap support. -;; XEmacs: removed to keymap.el +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Obsoleteness ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; The obsoleteness support at once point was scattered throughout various +;; source files. We then put the stuff in one place "to remove the +;; junkiness from other source files and to facilitate creating/updating +;; things like sysdep.el". However, it never really worked, and it's +;; contrary to general practice to do such things -- all related stuff should +;; be grouped together. So it's split up again, although the following +;; things haven't found a home yet. -;;;; The global keymap tree. +;; Much very old obsolete stuff has been removed entirely (e.g. anything +;; with `dot' in place of `point'). -;;; global-map, esc-map, and ctl-x-map have their values set up in -;;; keymap.c; we just give them docstrings here. - -;;;; Event manipulation functions. - -;; XEmacs: This stuff is done in C Code. - -;;;; Obsolescent names for functions generally appear elsewhere, in -;;;; obsolete.el or in the files they are related do. Many very old -;;;; obsolete stuff has been removed entirely (e.g. anything with `dot' in -;;;; place of `point'). - ; alternate names (not obsolete) (if (not (fboundp 'mod)) (define-function 'mod '%)) (define-function 'move-marker 'set-marker) ＠＠ -207,16 +207,121 ＠＠ (define-function 'set-match-data 'store-match-data) (define-function 'send-string-to-terminal 'external-debugging-output) -;; XEmacs: -(defun local-variable-if-set-p (sym buffer) - "Return t if SYM would be local to BUFFER after it is set. -A nil value for BUFFER is *not* the same as (current-buffer), but -can be used to determine whether `make-variable-buffer-local' has been -called on SYM." - (local-variable-p sym buffer t)) +;; We have to put these here, not bytecomp-runtime, because it doesn't like +;; defsubsts there. + +(defsubst define-obsolete-function-alias (oldfun newfun) + "Define OLDFUN as an obsolete alias for function NEWFUN. +This makes calling OLDFUN equivalent to calling NEWFUN and marks OLDFUN +as obsolete." + (define-function oldfun newfun) + (make-obsolete oldfun newfun)) + +(defsubst define-compatible-function-alias (oldfun newfun) + "Define OLDFUN as a compatible alias for function NEWFUN. +This makes calling OLDFUN equivalent to calling NEWFUN and marks OLDFUN +as provided for compatibility only." + (define-function oldfun newfun) + (make-compatible oldfun newfun)) + +(defsubst define-obsolete-variable-alias (oldvar newvar) + "Define OLDVAR as an obsolete alias for variable NEWVAR. +This makes referencing or setting OLDVAR equivalent to referencing or +setting NEWVAR and marks OLDVAR as obsolete. +If OLDVAR was bound and NEWVAR was not, Set NEWVAR to OLDVAR. + +Note: Use this before any other references (defvar/defcustom) to NEWVAR." + (let ((needs-setting (and (boundp oldvar) (not (boundp newvar)))) + (value (and (boundp oldvar) (symbol-value oldvar)))) + (defvaralias oldvar newvar) + (make-obsolete-variable oldvar newvar) + (and needs-setting (set newvar value)))) + +(defsubst define-compatible-variable-alias (oldvar newvar) + "Define OLDVAR as a compatible alias for variable NEWVAR. +This makes referencing or setting OLDVAR equivalent to referencing or +setting NEWVAR and marks OLDVAR as provided for compatibility only." + (defvaralias oldvar newvar) + (make-compatible-variable oldvar newvar)) + +(make-compatible-variable 'lisp-indent-hook 'lisp-indent-function) +(make-compatible-variable 'comment-indent-hook 'comment-indent-function) +(make-obsolete-variable 'temp-buffer-show-hook + 'temp-buffer-show-function) +(make-obsolete-variable 'inhibit-local-variables + "use `enable-local-variables' (with the reversed sense).") +(make-obsolete-variable 'suspend-hooks 'suspend-hook) +(make-obsolete-variable 'first-change-function 'first-change-hook) +(make-obsolete-variable 'before-change-function + "use before-change-functions; which is a list of functions rather than a single function.") +(make-obsolete-variable 'after-change-function + "use after-change-functions; which is a list of functions rather than a single function.") + +;; (defun user-original-login-name () +;; "Return user's login name from original login. +;; This tries to remain unaffected by `su', by looking in environment variables." +;; (or (getenv "LOGNAME") (getenv "USER") (user-login-name))) +(define-obsolete-function-alias 'user-original-login-name 'user-login-name) + +(define-obsolete-function-alias 'show-buffer 'set-window-buffer) +(define-obsolete-function-alias 'buffer-flush-undo 'buffer-disable-undo) +(make-compatible 'eval-current-buffer 'eval-buffer) +(define-compatible-function-alias 'byte-code-function-p + 'compiled-function-p) ;FSFmacs + +(define-obsolete-function-alias 'isearch-yank-x-selection + 'isearch-yank-selection) +(define-obsolete-function-alias 'isearch-yank-x-clipboard + 'isearch-yank-clipboard) + +;; too bad there's not a way to check for aref, assq, and nconc +;; being called on the values of functions known to return keymaps, +;; or known to return vectors of events instead of strings... + +(make-obsolete-variable 'executing-macro 'executing-kbd-macro) + +(define-compatible-function-alias 'interactive-form + 'function-interactive) ;GNU 21.1 +(define-compatible-function-alias 'assq-delete-all + 'remassq) ;GNU 21.1 + +(defun makehash (&optional test) + "Create a new hash table. +Optional first argument TEST specifies how to compare keys in the table. +Predefined tests are `eq', `eql', and `equal'. Default is `eql'." + (make-hash-table :test test)) +(make-compatible 'makehash 'make-hash-table) + +(define-compatible-function-alias 'line-beginning-position 'point-at-bol) +(define-compatible-function-alias 'line-end-position 'point-at-eol) + +;; not obsolete. +;; #### These are a bad idea, because the CL RPLACA and RPLACD +;; return the cons cell, not the new CAR/CDR. -hniksic +;; The proper definition would be: +;; (defun rplaca (conscell newcar) +;; (setcar conscell newcar) +;; conscell) +;; ...and analogously for RPLACD. +(define-function 'rplaca 'setcar) +(define-function 'rplacd 'setcdr) + +(defun redraw-display (&optional device) + (if (eq device t) + (mapcar 'redisplay-device (device-list)) + (redisplay-device device))) + +;; Keywords already do The Right Thing in XEmacs +(make-compatible 'define-widget-keywords "Just use them") + +;; the functionality of column.el has been moved into C +;; Function obsoleted for XEmacs 20.0/February 1997. +(defalias 'display-column-mode 'column-number-mode)  -;;;; Hook manipulation functions. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Hook manipulation functions ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; (defconst run-hooks 'run-hooks ...) ＠＠ -411,16 +516,9 ＠＠ "Function or functions to be called when `kill-emacs' is called, just before emacs is actually killed.") -;; not obsolete. -;; #### These are a bad idea, because the CL RPLACA and RPLACD -;; return the cons cell, not the new CAR/CDR. -hniksic -;; The proper definition would be: -;; (defun rplaca (conscell newcar) -;; (setcar conscell newcar) -;; conscell) -;; ...and analogously for RPLACD. -(define-function 'rplaca 'setcar) -(define-function 'rplacd 'setcdr) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Symbol functions ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun copy-symbol (symbol &optional copy-properties) "Return a new uninterned symbol with the same name as SYMBOL. ＠＠ -447,21 +545,32 ＠＠ (with-current-buffer buffer (set sym val))) +(defun buffer-local-value (variable buffer) + "Return the value of VARIABLE in BUFFER. +If VARIABLE does not have a buffer-local binding in BUFFER, the value +is the default binding of variable." + (symbol-value-in-buffer variable buffer)) +(make-compatible 'buffer-local-value 'symbol-value-in-buffer) + +;; XEmacs: +(defun local-variable-if-set-p (sym buffer) + "Return t if SYM would be local to BUFFER after it is set. +A nil value for BUFFER is *not* the same as (current-buffer), but +can be used to determine whether `make-variable-buffer-local' has been +called on SYM." + (local-variable-p sym buffer t)) + +;; defined in lisp/bindings.el in GNU Emacs. +(defmacro bound-and-true-p (var) + "Return the value of symbol VAR if it is bound, else nil." + `(and (boundp (quote ,var)) ,var)) +  ;; BEGIN SYNCHED WITH FSF 21.2 -;; #### #### #### AAaargh! Must be in C, because it is used insanely -;; early in the bootstrap process. -;(defun split-path (path) -; "Explode a search path into a list of strings. -;The path components are separated with the characters specified -;with `path-separator'." -; (while (or (not stringp path-separator) -; (/= (length path-separator) 1)) -; (setq path-separator (signal 'error (list "\ -;`path-separator' should be set to a single-character string" -; path-separator)))) -; (split-string-by-char path (aref separator 0))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; with-* functions ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defmacro with-current-buffer (buffer &rest body) "Temporarily make BUFFER the current buffer and execute the forms in BODY. ＠＠ -617,6 +726,11 ＠＠ (put 'with-syntax-table 'edebug-form-spec '(form body)) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; String functions ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + ;; Moved from mule-coding.el. (defmacro with-string-as-buffer-contents (str &rest body) "With the contents of the current buffer being STR, run BODY. ＠＠ -627,7 +741,46 ＠＠ ,＠body (buffer-string))) - +;; This is now in C. +;(defun buffer-substring-no-properties (start end) +; "Return the text from START to END, without text properties, as a string." +; (let ((string (buffer-substring start end))) +; (set-text-properties 0 (length string) nil string) +; string)) + +;; This function used to be an alias to `buffer-substring', except +;; that FSF Emacs 20.4 added a BUFFER argument in an incompatible way. +;; The new FSF's semantics makes more sense, but we try to support +;; both for backward compatibility. +(defun buffer-string (&optional buffer old-end old-buffer) + "Return the contents of the current buffer as a string. +If narrowing is in effect, this function returns only the visible part +of the buffer. + +If BUFFER is specified, the contents of that buffer are returned. + +The arguments OLD-END and OLD-BUFFER are supported for backward +compatibility with pre-21.2 XEmacsen times when arguments to this +function were (buffer-string &optional START END BUFFER)." + (cond + ((or (stringp buffer) (bufferp buffer)) + ;; Most definitely the new way. + (buffer-substring nil nil buffer)) + ((or (stringp old-buffer) (bufferp old-buffer) + (natnump buffer) (natnump old-end)) + ;; Definitely the old way. + (buffer-substring buffer old-end old-buffer)) + (t + ;; Probably the old way. + (buffer-substring buffer old-end old-buffer)))) + +;; `delete-and-extract-region' is a builtin in GNU Emacs 21. +(defun delete-and-extract-region (start end) + "Delete the text between START and END and return it." + (let ((region (buffer-substring start end))) + (delete-region start end) + region)) + (defmacro save-match-data (&rest body) "Execute BODY forms, restoring the global value of the match data." (let ((original (make-symbol "match-data"))) ＠＠ -662,6 +815,18 ＠＠ result) (buffer-substring-no-properties (match-beginning num) (match-end num))))) +;; #### #### #### AAaargh! Must be in C, because it is used insanely +;; early in the bootstrap process. +;(defun split-path (path) +; "Explode a search path into a list of strings. +;The path components are separated with the characters specified +;with `path-separator'." +; (while (or (not stringp path-separator) +; (/= (length path-separator) 1)) +; (setq path-separator (signal 'error (list "\ +;`path-separator' should be set to a single-character string" +; path-separator)))) +; (split-string-by-char path (aref separator 0))) (defconst split-string-default-separators "[ \f\t\n\r\v]+" "The default value of separators for `split-string'. ＠＠ -875,17 +1040,6 ＠＠ (set-extent-face ext face) ext)) -;; not obsolete. -(define-function 'string= 'string-equal) -(define-function 'string< 'string-lessp) -(define-function 'int-to-string 'number-to-string) -(define-function 'string-to-int 'string-to-number) - -;; These two names are a bit awkward, as they conflict with the normal -;; foo-to-bar naming scheme, but CLtL2 has them, so they stay. -(define-function 'char-int 'char-to-int) -(define-function 'int-char 'int-to-char) - (defun string-width (string) "Return number of columns STRING occupies when displayed. With international (Mule) support, uses the charset-columns attribute of ＠＠ -910,10 +1064,10 ＠＠ (charset-width (char-charset character))) 1)) -;; The following several functions are useful in GNU Emacs 20 because -;; of the multibyte "characters" the internal representation of which -;; leaks into Lisp. In XEmacs/Mule they are trivial and unnecessary. -;; We provide them for compatibility reasons solely. +;; Some of the following functions came into existence in GNU Emacs 20 +;; because of the multibyte "characters", the internal representation of +;; which leaks into Lisp. They would be trivial and unnecessary in XEmacs +;; (and in current GNU Emacs, which fixed the problem). (defun string-to-sequence (string type) "Convert STRING to a sequence of TYPE which contains characters in STRING. ＠＠ -1038,8 +1192,53 ＠＠ (concat head-padding str tail-padding ellipses) (concat str ellipses))))) +;; not obsolete. +(define-function 'string= 'string-equal) +(define-function 'string< 'string-lessp) +(define-function 'int-to-string 'number-to-string) +(define-function 'string-to-int 'string-to-number) + +;; These two names are a bit awkward, as they conflict with the normal +;; foo-to-bar naming scheme, but CLtL2 has them, so they stay. +(define-function 'char-int 'char-to-int) +(define-function 'int-char 'int-to-char) +(define-obsolete-function-alias 'sref 'aref) + +(defun char-bytes (character) + "Return number of bytes a CHARACTER occupies in a string or buffer. +It always returns 1 in XEmacs, and in recent FSF Emacs versions." + 1) +(make-obsolete 'char-bytes "This function always returns 1") + +(defun find-non-ascii-charset-string (string) + "Return a list of charsets in the STRING except ascii. +It might be available for compatibility with Mule 2.3, +because its `find-charset-string' ignores ASCII charset." + (delq 'ascii (charsets-in-string string))) +(make-obsolete 'find-non-ascii-charset-string + "use (delq 'ascii (charsets-in-string STRING)) instead.") + +(defun find-non-ascii-charset-region (start end) + "Return a list of charsets except ascii in the region between START and END. +It might be available for compatibility with Mule 2.3, +because its `find-charset-string' ignores ASCII charset." + (delq 'ascii (charsets-in-region start end))) +(make-obsolete 'find-non-ascii-charset-region + "use (delq 'ascii (charsets-in-region START END)) instead.") + +;; Two loser functions which shouldn't be used. +(make-obsolete 'following-char 'char-after) +(make-obsolete 'preceding-char 'char-before) + +(define-compatible-function-alias 'insert-and-inherit 'insert) +(define-compatible-function-alias 'insert-before-markers-and-inherit + 'insert-before-markers) +  -;; alist/plist functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Plist functions ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (defun plist-to-alist (plist) "Convert property list PLIST into the equivalent association-list form. The alist is returned. This converts from ＠＠ -1127,7 +1326,9 ＠＠ Analogous to (setq LAX-PLIST (lax-plist-remprop LAX-PLIST PROPERTY))." `(setq ,lax-plist (lax-plist-remprop ,lax-plist ,property)))  -;;; Error functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Error functions ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun error (datum &rest args) "Signal a non-continuable error. ＠＠ -1436,30 +1637,10 ＠＠ ,error-form ,＠(if resignal '((signal (car __cte_cc_var__) (cdr __cte_cc_var__))))) ))) - -;;;; Miscellanea. - -;; This is now in C. -;(defun buffer-substring-no-properties (start end) -; "Return the text from START to END, without text properties, as a string." -; (let ((string (buffer-substring start end))) -; (set-text-properties 0 (length string) nil string) -; string)) -(defun get-buffer-window-list (&optional buffer minibuf frame) - "Return windows currently displaying BUFFER, or nil if none. -BUFFER defaults to the current buffer. -See `walk-windows' for the meaning of MINIBUF and FRAME." - (cond ((null buffer) - (setq buffer (current-buffer))) - ((not (bufferp buffer)) - (setq buffer (get-buffer buffer)))) - (let (windows) - (walk-windows (lambda (window) - (if (eq (window-buffer window) buffer) - (push window windows))) - minibuf frame) - windows)) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Misc functions ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun ignore (&rest ignore) "Do nothing and return nil. ＠＠ -1467,33 +1648,6 ＠＠ (interactive) nil) -;; defined in lisp/bindings.el in GNU Emacs. -(defmacro bound-and-true-p (var) - "Return the value of symbol VAR if it is bound, else nil." - `(and (boundp (quote ,var)) ,var)) - -;; `propertize' is a builtin in GNU Emacs 21. -(defun propertize (string &rest properties) - "Return a copy of STRING with text properties added. -First argument is the string to copy. -Remaining arguments form a sequence of PROPERTY VALUE pairs for text -properties to add to the result." - (let ((str (copy-sequence string))) - (add-text-properties 0 (length str) - properties - str) - str)) - -;; `delete-and-extract-region' is a builtin in GNU Emacs 21. -(defun delete-and-extract-region (start end) - "Delete the text between START and END and return it." - (let ((region (buffer-substring start end))) - (delete-region start end) - region)) - -(define-function 'eval-in-buffer 'with-current-buffer) -(make-obsolete 'eval-in-buffer 'with-current-buffer) - ;;; The real defn is in abbrev.el but some early callers ;;; (eg lisp-mode-abbrev-table) want this before abbrev.el is loaded... ＠＠ -1542,32 +1696,6 ＠＠ (or (null (function-max-args function)) (<= n (function-max-args function))))) -;; This function used to be an alias to `buffer-substring', except -;; that FSF Emacs 20.4 added a BUFFER argument in an incompatible way. -;; The new FSF's semantics makes more sense, but we try to support -;; both for backward compatibility. -(defun buffer-string (&optional buffer old-end old-buffer) - "Return the contents of the current buffer as a string. -If narrowing is in effect, this function returns only the visible part -of the buffer. - -If BUFFER is specified, the contents of that buffer are returned. - -The arguments OLD-END and OLD-BUFFER are supported for backward -compatibility with pre-21.2 XEmacsen times when arguments to this -function were (buffer-string &optional START END BUFFER)." - (cond - ((or (stringp buffer) (bufferp buffer)) - ;; Most definitely the new way. - (buffer-substring nil nil buffer)) - ((or (stringp old-buffer) (bufferp old-buffer) - (natnump buffer) (natnump old-end)) - ;; Definitely the old way. - (buffer-substring buffer old-end old-buffer)) - (t - ;; Probably the old way. - (buffer-substring buffer old-end old-buffer)))) - ;; BEGIN SYNC WITH FSF 21.2 ;; This was not present before. I think Jamie had some objections ＠＠ -1617,6 +1745,9 ＠＠ FILE should be the name of a library, with no directory name." (eval-after-load file (read))) (make-compatible 'eval-next-after-load "") + +(define-function 'eval-in-buffer 'with-current-buffer) +(make-obsolete 'eval-in-buffer 'with-current-buffer) ;; END SYNC WITH FSF 21.2 1.5.6.1 +11 -0 XEmacs/xemacs/lisp/text-props.el Index: text-props.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/text-props.el,v retrieving revision 1.5 retrieving revision 1.5.6.1 diff -u -r1.5 -r1.5.6.1 --- text-props.el 2003/02/08 02:29:53 1.5 +++ text-props.el 2005/02/16 00:40:44 1.5.6.1 ＠＠ -395,6 +395,17 ＠＠ ; (map-extents #'(lambda (x i) (detach-extent x) nil) ; buffer)) +;; `propertize' is a builtin in GNU Emacs 21. +(defun propertize (string &rest properties) + "Return a copy of STRING with text properties added. +First argument is the string to copy. +Remaining arguments form a sequence of PROPERTY VALUE pairs for text +properties to add to the result." + (let ((str (copy-sequence string))) + (add-text-properties 0 (length str) + properties + str) + str)) (provide 'text-props) 1.7.6.1 +13 -10 XEmacs/xemacs/lisp/widgets-gtk.el Index: widgets-gtk.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/widgets-gtk.el,v retrieving revision 1.7 retrieving revision 1.7.6.1 diff -u -r1.7 -r1.7.6.1 --- widgets-gtk.el 2004/11/04 23:05:56 1.7 +++ widgets-gtk.el 2005/02/16 00:40:44 1.7.6.1 ＠＠ -39,22 +39,25 ＠＠ gtk-entry-new gtk-entry-set-text gtk-widget-set-style gtk-widget-get-style)) +Bill, please check the stuff below and correct -- note the missing +text field, eg + (defun gtk-widget-get-callback (widget plist instance) (let ((cb (plist-get plist :callback)) - (ex (plist-get plist :callback-ex)) (real-cb nil)) (cond - (ex - (gtk-signal-connect widget 'button-release-event - (lambda (widget event data) - (put widget 'last-event event))) - `(lambda (widget &rest ignored) - (funcall ,ex ,instance (get widget 'last-event)))) (cb `(lambda (widget &rest ignored) - (if (functionp ,real-cb) - (funcall ,real-cb) - (eval ,real-cb)))) +; (gtk-signal-connect widget 'button-release-event +; (lambda (widget event data) +; (put widget 'last-event event))) + (let ((ev (make-event 'activate + `(channel ,instance + callback ,real-cb + text foo)))) + (if (commandp ,real-cb t) + (call-interactively ,real-cb nil (vector ev)) + (eval ,real-cb))))) (t nil)))) 1.10.6.1 +19 -0 XEmacs/xemacs/lisp/window.el Index: window.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/window.el,v retrieving revision 1.10 retrieving revision 1.10.6.1 diff -u -r1.10 -r1.10.6.1 --- window.el 2003/02/09 09:33:42 1.10 +++ window.el 2005/02/16 00:40:45 1.10.6.1 ＠＠ -165,6 +165,21 ＠＠ minibuf all-frames) default)) +(defun get-buffer-window-list (&optional buffer minibuf frame) + "Return windows currently displaying BUFFER, or nil if none. +BUFFER defaults to the current buffer. +See `walk-windows' for the meaning of MINIBUF and FRAME." + (cond ((null buffer) + (setq buffer (current-buffer))) + ((not (bufferp buffer)) + (setq buffer (get-buffer buffer)))) + (let (windows) + (walk-windows (lambda (window) + (if (eq (window-buffer window) buffer) + (push window windows))) + minibuf frame) + windows)) + (defalias 'some-window 'get-window-with-predicate) (defun minibuffer-window-active-p (window) ＠＠ -585,5 +600,9 ＠＠ ;; Maybe get rid of the window. (and window (not window-handled) (not window-solitary) (delete-window window)))) + +;; obsoleteness + +(make-obsolete 'set-window-dot 'set-window-point) ;;; window.el ends here No revision No revision 1.11.6.1 +5 -5 XEmacs/xemacs/lwlib/lwlib-Xaw.c Index: lwlib-Xaw.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lwlib/lwlib-Xaw.c,v retrieving revision 1.11 retrieving revision 1.11.6.1 diff -u -r1.11 -r1.11.6.1 --- lwlib-Xaw.c 2004/09/20 19:19:16 1.11 +++ lwlib-Xaw.c 2005/02/16 00:41:43 1.11.6.1 ＠＠ -638,11 +638,11 ＠＠ event_data.time = 0; if ((int) call_data > 0) - /* event_data.action = SCROLLBAR_PAGE_DOWN;*/ - event_data.action = SCROLLBAR_LINE_DOWN; + /* event_data.action = LW_SCROLLBAR_PAGE_DOWN;*/ + event_data.action = LW_SCROLLBAR_LINE_DOWN; else - /* event_data.action = SCROLLBAR_PAGE_UP;*/ - event_data.action = SCROLLBAR_LINE_UP; + /* event_data.action = LW_SCROLLBAR_PAGE_UP;*/ + event_data.action = LW_SCROLLBAR_LINE_UP; if (instance->info->pre_activate_cb) instance->info->pre_activate_cb (widget, id, (XtPointer) &event_data); ＠＠ -668,7 +668,7 ＠＠ (int) (percent * (float) (val->maximum - val->minimum)) + val->minimum; event_data.time = 0; - event_data.action = SCROLLBAR_DRAG; + event_data.action = LW_SCROLLBAR_DRAG; if (instance->info->pre_activate_cb) instance->info->pre_activate_cb (widget, id, (XtPointer) &event_data); 1.13.6.1 +9 -9 XEmacs/xemacs/lwlib/lwlib-Xlw.c Index: lwlib-Xlw.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lwlib/lwlib-Xlw.c,v retrieving revision 1.13 retrieving revision 1.13.6.1 diff -u -r1.13 -r1.13.6.1 --- lwlib-Xlw.c 2004/09/20 19:19:16 1.13 +++ lwlib-Xlw.c 2005/02/16 00:41:43 1.13.6.1 ＠＠ -205,15 +205,15 ＠＠ switch (data->reason) { - case XmCR_DECREMENT: event_data.action = SCROLLBAR_LINE_UP; break; - case XmCR_INCREMENT: event_data.action = SCROLLBAR_LINE_DOWN; break; - case XmCR_PAGE_DECREMENT: event_data.action = SCROLLBAR_PAGE_UP; break; - case XmCR_PAGE_INCREMENT: event_data.action = SCROLLBAR_PAGE_DOWN; break; - case XmCR_TO_TOP: event_data.action = SCROLLBAR_TOP; break; - case XmCR_TO_BOTTOM: event_data.action = SCROLLBAR_BOTTOM; break; - case XmCR_DRAG: event_data.action = SCROLLBAR_DRAG; break; - case XmCR_VALUE_CHANGED: event_data.action = SCROLLBAR_CHANGE; break; - default: event_data.action = SCROLLBAR_CHANGE; break; + case XmCR_DECREMENT: event_data.action = LW_SCROLLBAR_LINE_UP; break; + case XmCR_INCREMENT: event_data.action = LW_SCROLLBAR_LINE_DOWN; break; + case XmCR_PAGE_DECREMENT:event_data.action = LW_SCROLLBAR_PAGE_UP; break; + case XmCR_PAGE_INCREMENT:event_data.action = LW_SCROLLBAR_PAGE_DOWN; break; + case XmCR_TO_TOP: event_data.action = LW_SCROLLBAR_TOP; break; + case XmCR_TO_BOTTOM: event_data.action = LW_SCROLLBAR_BOTTOM; break; + case XmCR_DRAG: event_data.action = LW_SCROLLBAR_DRAG; break; + case XmCR_VALUE_CHANGED: event_data.action = LW_SCROLLBAR_CHANGE; break; + default: event_data.action = LW_SCROLLBAR_CHANGE; break; } if (instance->info->pre_activate_cb) 1.23.6.1 +9 -9 XEmacs/xemacs/lwlib/lwlib-Xm.c Index: lwlib-Xm.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lwlib/lwlib-Xm.c,v retrieving revision 1.23 retrieving revision 1.23.6.1 diff -u -r1.23 -r1.23.6.1 --- lwlib-Xm.c 2004/09/27 18:39:11 1.23 +++ lwlib-Xm.c 2005/02/16 00:41:44 1.23.6.1 ＠＠ -2176,31 +2176,31 ＠＠ switch (data->reason) { case XmCR_DECREMENT: - event_data.action = SCROLLBAR_LINE_UP; + event_data.action = LW_SCROLLBAR_LINE_UP; break; case XmCR_INCREMENT: - event_data.action = SCROLLBAR_LINE_DOWN; + event_data.action = LW_SCROLLBAR_LINE_DOWN; break; case XmCR_PAGE_DECREMENT: - event_data.action = SCROLLBAR_PAGE_UP; + event_data.action = LW_SCROLLBAR_PAGE_UP; break; case XmCR_PAGE_INCREMENT: - event_data.action = SCROLLBAR_PAGE_DOWN; + event_data.action = LW_SCROLLBAR_PAGE_DOWN; break; case XmCR_TO_TOP: - event_data.action = SCROLLBAR_TOP; + event_data.action = LW_SCROLLBAR_TOP; break; case XmCR_TO_BOTTOM: - event_data.action = SCROLLBAR_BOTTOM; + event_data.action = LW_SCROLLBAR_BOTTOM; break; case XmCR_DRAG: - event_data.action = SCROLLBAR_DRAG; + event_data.action = LW_SCROLLBAR_DRAG; break; case XmCR_VALUE_CHANGED: - event_data.action = SCROLLBAR_CHANGE; + event_data.action = LW_SCROLLBAR_CHANGE; break; default: - event_data.action = SCROLLBAR_CHANGE; + event_data.action = LW_SCROLLBAR_CHANGE; break; } 1.8.12.1 +8 -8 XEmacs/xemacs/lwlib/lwlib.h Index: lwlib.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lwlib/lwlib.h,v retrieving revision 1.8 retrieving revision 1.8.12.1 diff -u -r1.8 -r1.8.12.1 --- lwlib.h 2001/07/28 05:08:59 1.8 +++ lwlib.h 2005/02/16 00:41:44 1.8.12.1 ＠＠ -65,14 +65,14 ＠＠ typedef enum _scroll_action { - SCROLLBAR_LINE_UP = 0, - SCROLLBAR_LINE_DOWN = 1, - SCROLLBAR_PAGE_UP = 2, - SCROLLBAR_PAGE_DOWN = 3, - SCROLLBAR_DRAG = 4, - SCROLLBAR_CHANGE = 5, - SCROLLBAR_TOP = 6, - SCROLLBAR_BOTTOM = 7 + LW_SCROLLBAR_LINE_UP = 0, + LW_SCROLLBAR_LINE_DOWN = 1, + LW_SCROLLBAR_PAGE_UP = 2, + LW_SCROLLBAR_PAGE_DOWN = 3, + LW_SCROLLBAR_DRAG = 4, + LW_SCROLLBAR_CHANGE = 5, + LW_SCROLLBAR_TOP = 6, + LW_SCROLLBAR_BOTTOM = 7 } scroll_action; typedef struct _scroll_event No revision No revision 1.59.4.1 +141 -58 XEmacs/xemacs/man/internals/internals.texi Index: internals.texi =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/man/internals/internals.texi,v retrieving revision 1.59 retrieving revision 1.59.4.1 diff -u -r1.59 -r1.59.4.1 --- internals.texi 2005/01/26 09:48:27 1.59 +++ internals.texi 2005/02/16 00:41:58 1.59.4.1 ＠＠ -14150,17 +14150,17 ＠＠ ＠enumerate ＠item Determine desired display in area that needs redisplay. -Implemented by ＠code{redisplay.c} +Implemented by ＠code{redisplay.c}. ＠item -Compare desired display with current display -Implemented by ＠code{redisplay-output.c} +Compare desired display with current display. +Implemented by ＠code{redisplay-output.c}. ＠item Output changes Implemented by ＠code{redisplay-output.c}, ＠code{redisplay-x.c}, ＠code{redisplay-msw.c} and ＠code{redisplay-tty.c} ＠end enumerate Steps 1 and 2 are device-independent and relatively complex. Step 3 is -mostly device-dependent. +partly device-dependent. Determining the desired display ＠＠ -14172,21 +14172,17 ＠＠ The ＠code{display_line} structures are tightly tied to buffers which presents a problem for redisplay as this connection is bogus for the -modeline. Hence the ＠code{display_line} generation routines are -duplicated for generating the modeline. This means that the modeline +modeline. Hence the ＠code{display_line} generation routines are +duplicated for generating the modeline. This means that the modeline display code has many bugs that the standard redisplay code does not. The guts of ＠code{display_line} generation are in ＠code{create_text_block}, which creates a single display line for the -desired locale. This incrementally parses the characters on the current +desired locale. This incrementally parses the characters on the current line and generates redisplay structures for each. -Gutter redisplay is different. Because the data to display is stored in -a string we cannot use ＠code{create_text_block}. Instead we use -＠code{create_text_string_block} which performs the same function as -＠code{create_text_block} but for strings. Many of the complexities of -＠code{create_text_block} to do with cursor handling and selective -display have been removed. +＠code{create_text_block} can also handle string display, which is used +for the gutter, where the data to display is stored in a string. ＠node Modules for the Redisplay Mechanism, Modules for other Display-Related Lisp Objects, Redisplay Piece by Piece, The Redisplay Mechanism ＠section Modules for the Redisplay Mechanism ＠＠ -14681,6 +14677,16 ＠＠ ＠chapter Glyphs ＠cindex glyphs +＠menu +* Introduction to Glyphs:: +* Glyph Instantiation:: +* Widget Glyphs:: +＠end menu + +＠node Introduction to Glyphs +＠section Introduction to Glyphs +＠cindex glyphs, introduction + Glyphs are graphical elements that can be displayed in XEmacs buffers or gutters. We use the term graphical element here in the broadest possible sense since glyphs can be as mundane as text or as arcane as a native ＠＠ -14721,6 +14727,7 ＠＠ Any action on a glyph first consults the cache before actually instantiating a widget. +＠node Glyph Instantiation ＠section Glyph Instantiation ＠cindex glyph instantiation ＠cindex instantiation, glyph ＠＠ -14789,22 +14796,97 ＠＠ governing-domain. The governing domain for an image-instance is determined using the governing_domain image-instance method. -＠section Widget-Glyphs -＠cindex widget-glyphs +＠node Widget Glyphs +＠section Widget Glyphs +＠cindex widget glyphs +＠cindex glyphs, widget + +＠menu +* Widget Redisplay:: +* Widget Glyphs in the MS-Windows Environment:: +* Widget Glyphs in the X Environment:: +＠end menu -＠section Widget-Glyphs in the MS-Windows Environment -＠cindex widget-glyphs in the MS-Windows environment -＠cindex MS-Windows environment, widget-glyphs in the +＠node Widget Redisplay +＠subsection Widget Redisplay +＠cindex widget redisplay +＠cindex redisplay, widget + +Widget redisplay follows the general asynchronous nature of redisplay +in general - that is items for display are updated separately to their +actual visual representation. For instance a tab control has serveral +lisp structures associated with it. When the tab structure is changed, +thes lisp structures are changed, but it is not until redisplay proper +that you actually see any change. There are several reasons for doing +it this way, one is that it conforms more closely to the second rule +of redisplay - not to call lisp during redisplay. The actual mechanics +of this is encoded in two image instance methods - +update_image_instance and redisplay_subwindow with obvious +meanings. These methods delegate to widget specific versions via +update_widget and redisplay_widget. These in turn delegate to device +and format specific methods - for example layout_update and +mswindows_button_redisplay. + +update_image_instance bears further discussion since it encapsulates +behaviour that is important to understand. To change a widget the +image instance is not manipulated directly, but rather its +instantiator is changed and then these changes are propogated to image +instances that are instantiated by this instantiator. However, in +order for this behaviour to work properly it is important that the +image instances are not recreated - as would be the case in a naive +implementation - unless absolutely necessary. Thus, the image instance +cache for widgets is keyed on the glyph identity and the widget type +*not* on the instantiator. When image_instantiate is called it looks +up the image_instance based on its glyph and domain and if a match is +found update_image_instance is called with the new instantiator. The +cache is keyed on the image type as well as the glyph because it would +be impossible to merely update an image instance representing one gui +widget to another; for instance converting a button to a tree-view. +update_image_instance compares the original instantiator and then +calls widget_update with only those keyword-value pairs that have +changed. The individual image instance update functions then update +the internal structure of the widget using those values. + +However, herein lies a problem - redisplay optimizes which parts of +the screen it is going to display by comparing current and future +redisplay structures, however in the case of glyphs the glyphs are the +same object in both sets of structures. This is because otherwise +glyphs and image instances would be recreated each time redisplay was +called. So how does redisplay know whether to actually update the +displayed properties of image instances? The solution is a set of +`dirty' bits in the image instance which are set depending on what +changes update_image_instance has actually made. The flags also need +to be propagated up to the glyph so that redisplay can tell easily +whether something might have been changed or not. We say `might' here +because it is possible for the same glyph to have diffferent +instantiators in different domains and thus redisplay must update only +the image instances for the instantiator that has changed. The +dirtiness or otherwise of a glyph is encapsulated in +imge_instance_changed and also compare_runes. When a +determination of dirtiness has been made the image is redisplayed +using redisplay_subwindow. This propogates the lisp structure +changes (in gui_item) into on-screen properties and then marks the +structure and instantiator as up-to-date. In both X and mswindows a +lot of generic updating is done in mswindows_redisplay_widget and +x_redisplay_widget. In fact under X this is pretty much the only +function that gets called since the updates are then delegated to +lwlib to handle. + +＠node Widget Glyphs in the MS-Windows Environment +＠subsection Widget Glyphs in the MS-Windows Environment +＠cindex widget glyphs in the MS-Windows environment +＠cindex MS-Windows environment, widget glyphs in the To Do -＠section Widget-Glyphs in the X Environment -＠cindex widget-glyphs in the X environment -＠cindex X environment, widget-glyphs in the +＠node Widget Glyphs in the X Environment +＠subsection Widget Glyphs in the X Environment +＠cindex widget glyphs in the X environment +＠cindex X environment, widget glyphs in the -Widget-glyphs under X make heavy use of lwlib (＠pxref{Lucid Widget +Widget glyphs under X make heavy use of lwlib (＠pxref{Lucid Widget Library}) for manipulating the native toolkit objects. This is primarily -so that different toolkits can be supported for widget-glyphs, just as +so that different toolkits can be supported for widget glyphs, just as they are supported for features such as menubars etc. Lwlib is extremely poorly documented and quite hairy so here is my ＠＠ -15075,8 +15157,8 ＠＠ | | | - command event queue | - if not from command + deferred event queue | + if not from deferred (contains events that were event queue, call read earlier but not processed, ＠code{event_stream_next_event()} typically when waiting in a | ＠＠ -15221,8 +15303,8 ＠＠ | | | - command event queue | - if not from command + deferred event queue | + if not from deferred (contains events that were event queue, call read earlier but not processed, ＠code{event_stream_next_event()} typically when waiting in a | ＠＠ -15266,8 +15348,7 ＠＠ ＠cindex event queues ＠cindex queues, event -There are two event queues here -- the command event queue (#### which -should be called "deferred event queue" and is in my glyph ws) and the +There are two event queues here -- the deferred event queue and the dispatch event queue. (MS Windows actually has an extra dispatch queue for non-user events and uses the generic one only for user events. This is because user and non-user events in Windows come through the same ＠＠ -15293,7 +15374,7 ＠＠ example, checking for pending expose events under X to avoid excessive server activity.) -The command event queue is used ＠strong{AFTER} an event has been read from +The deferred event queue is used ＠strong{AFTER} an event has been read from ＠code{next_event_internal()}, when it needs to be pushed back. This includes, for example, ＠code{accept-process-output}, ＠code{sleep-for} and ＠code{wait_delaying_user_input()}. Eval events and the like, ＠＠ -15302,14 +15383,14 ＠＠ Some events generated by callbacks are also pushed onto this queue, #### although maybe shouldn't be. -The command queue takes precedence over the dispatch queue. +The deferred queue takes precedence over the dispatch queue. #### It is worth investigating to see whether both queues are really needed, and how exactly they should be used. ＠code{enqueue-eval-event}, for example, could certainly push onto the dispatch queue, and all callbacks maybe should. ＠code{wait_delaying_user_input()} seems to need both queues, since it can take events from the dispatch queue and push -them onto the command queue; but it perhaps could be rewritten to avoid +them onto the deferred queue; but it perhaps could be rewritten to avoid this. #### In general we need to review the handling of these two queues, figure out exactly what ought to be happening, and document it. ＠＠ -15346,7 +15427,7 ＠＠ The slots of the event_stream structure: ＠table ＠code -＠item next_event_cb +＠item next_event A function which fills in an XEmacs_event structure with the next event available. If there is no event available, then this should block. ＠＠ -15354,10 +15435,10 ＠＠ returned if there are events of other types available; otherwise you can end up with an infinite loop in ＠code{Fdiscard_input()}. -＠item event_pending_cb +＠item event_pending A function which says whether there are events to be read. If called with an argument of 0, then this should say whether calling the -＠code{next_event_cb} will block. If called with a non-zero argument, +＠code{next_event} will block. If called with a non-zero argument, then this should say whether there are that many user-generated events pending (that is, keypresses, mouse-clicks, dialog-box selection events, etc.). (This is used for redisplay optimization, among other things.) ＠＠ -15368,24 +15449,24 ＠＠ ＠strong{must} return 0. Otherwise various undesirable effects will occur, such as redisplay not occurring until the next event occurs. -＠item handle_magic_event_cb +＠item handle_magic_event XEmacs calls this with an event structure which contains window-system dependent information that XEmacs doesn't need to know about, but which -must happen in order. If the ＠code{next_event_cb} never returns an +must happen in order. If the ＠code{next_event} never returns an event of type "magic", this will never be used. -＠item format_magic_event_cb +＠item format_magic_event Called with a magic event; print a representation of the innards of the event to ＠var{PSTREAM}. -＠item compare_magic_event_cb +＠item compare_magic_event Called with two magic events; return non-zero if the innards of the two are equal, zero otherwise. -＠item hash_magic_event_cb +＠item hash_magic_event Called with a magic event; return a hash of the innards of the event. -＠item add_timeout_cb +＠item add_timeout Called with an ＠var{EMACS_TIME}, the absolute time at which a wakeup event should be generated; and a void *, which is an arbitrary value that will be returned in the timeout event. The timeouts generated by this ＠＠ -15394,38 +15475,40 ＠＠ wakeup. If an implementation doesn't have microseconds or millisecond granularity, it should round up to the closest value it can deal with. -＠item remove_timeout_cb +＠item remove_timeout Called with an int, the id number of a wakeup to discard. This id -number must have been returned by the ＠code{add_timeout_cb}. If the given +number must have been returned by the ＠code{add_timeout}. If the given wakeup has already expired, this should do nothing. -＠item select_process_cb -＠item unselect_process_cb +＠item select_process +＠item unselect_process These callbacks tell the underlying implementation to add or remove a file descriptor from the list of fds which are polled for inferior-process input. When input becomes available on the given process connection, an event of type "process" should be generated. -＠item select_console_cb -＠item unselect_console_cb +＠item select_console +＠item unselect_console These callbacks tell the underlying implementation to add or remove a console from the list of consoles which are polled for user-input. -＠item select_device_cb -＠item unselect_device_cb +＠item select_device +＠item unselect_device These callbacks are used by Unixoid event loops (those that use ＠code{select()} and file descriptors and have a separate input fd per device). -＠item create_io_streams_cb -＠item delete_io_streams_cb +＠item create_io_streams +＠item delete_io_streams These callbacks are called by process code to create the input and output lstreams which are used for subprocess I/O. -＠item quitp_cb -A handler function called from the ＠code{QUIT} macro which should check -whether the quit character has been typed. On systems with SIGIO, this -will not be called unless the ＠code{sigio_happened} flag is true (it is set -from the SIGIO handler). +＠item drain_queue +A callback which should drain any pending user events from the window +system and put them onto the dispatch queue. + +＠item current_event_timestamp +A callback which should return a value corresponding to the current time, +using the same measurement as is used in event timestamps. ＠end table XEmacs has its own event structures, which are distinct from the event ＠＠ -15438,12 +15521,12 ＠＠ ＠code{detect_input_pending()} and ＠code{input-pending-p} look for input by calling ＠code{event_stream->event_pending_p} and looking in -＠code{[V]unread-command-event} and the ＠code{command_event_queue} (they +＠code{[V]unread-command-event} and the ＠code{deferred_event_queue} (they do not check for an executing keyboard macro, though). ＠code{discard-input} cancels any command events pending (and any keyboard macros currently executing), and puts the others onto the -＠code{command_event_queue}. There is a comment about a ``race +＠code{deferred_event_queue}. There is a comment about a ``race condition'', which is not a good sign. ＠code{next-command-event} and ＠code{read-char} are higher-level No revision No revision 1.790.4.1 +206 -0 XEmacs/xemacs/src/ChangeLog Index: ChangeLog =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/ChangeLog,v retrieving revision 1.790 retrieving revision 1.790.4.1 diff -u -r1.790 -r1.790.4.1 --- ChangeLog 2005/02/04 11:57:28 1.790 +++ ChangeLog 2005/02/16 00:42:23 1.790.4.1 ＠＠ -1,3 +1,209 ＠＠ +2002-05-19 Ben Wing <ben(a)xemacs.org&gt; + + Overview: + + ----------- Splitting up of misc-user event ---------- + + - eliminated "misc-user" and replaced it with four event types + activate, scrollbar, notify, and drop. "activate" includes all + user events that logically trigger callbacks -- menu, built-in + dialog-box, toolbar [#### but not currently under X], and + widget. "notify" includes random other stuff, + e.g. menu-no-selection and cancel-mode-internal. we properly + distinguish now between "command events" (which participate in + command building and include activate events but not the other + kinds) and "user events". C-u + menu-item now does what you'd + expect; never worked before. + + - the non-command user events (notify/scrollbar/drop) are + handled by calling a handler function stored in a variable, + e.g. dispatching a notify event calls the function stored in + the variable `notify-event-handler', which is normally the + function `default-notify-event-handler'; this implements the + semantics of the notify event. + + - all scrollbar code has been moved into Lisp. This, along with + the scrollbar-handler variable, should make it much easier to + customize the scrollbar behavior. + + - new functions for retrieving the values out of the new event + types more sensibly, e.g. for an activate event: event-callback, + event-text, event-image-instance (for widget activate events, + the channel is an image instance, and that's how event-image-instance + gets its value). + + - the old clunky event-function and event-object are still supported + and simulate what used to happen. + + - eliminated the junky :callback-ex that i added awhile ago [my + working assumption is that all widget code is still experimental + and thus i can change the interface without worrying too much + about compatibility], replacing it with what Andy had proposed -- + just use (interactive "e") in the callback, and retrieve the image + instance from the event, with the new `event-image-instance' [the + image instance is the channel]. + + - `put' and `get' now work properly on events, frames, image instances. + + ------------- Code review of redisplay code -------------- + + - Added redisplay documentation in various places. + - Took an axe to the proliferating, duplicated code in redisplay*.c: + -- combined create_text_block/create_string_text_block + -- combined generate_display_line/generate_string_display_line + -- combined create_left_glyph_block/create_right_glyph_block + -- combined foo_output_display_block -- device-specific versions + of the main routine to output a line (or actually a block), + which were all very similar to each other. Most of the logic + is now in the non-device-specific redisplay_output_display_block, + and there are some new device methods to handle outputting + strings, glyphs, etc. + -- eliminated some old grody cursor code in the X code that had + no hope of working. cleanly separated out cursor drawing from + everything else. + -- Fixed a likely typo in redisplay_move_cursor(). + -- Combined column_at_point/string_column_at_point. + + ------------- Code review of glyph code -------------- + + - Started documenting exactly how glyphs work. + - Formerly, the term "subwindow" was overloaded, sometimes with its + proper meaning of a child window-system window whose contents + are controlled by an external program, sometimes meaning either + a subwindow proper or a widget. To avoid confusion, I invented + the term "subcontrol" and use it to whenever we mean "subwindow + or widget". I also eliminated a few places were "subwindow" was + used to mean "child window" of an XEmacs window. + - Redid the subcontrol caches -- formerly they were duplicated on + the window and frame level, now only on the frame level. + - Fixed problem of same subcontrol in two places in the same window + by keeping track of the "governing object" of each glyph + (e.g. its extent or toolbar button object) in the subcontrol + cache, so that we get different image instances and hence + different subcontrols. We use the MATCHSPEC parameter to + specifier-instance to pass this value in. + - Cleaned up glyph cachels. Eliminated cachel dirty flag, which has + no purpose. #### Still more work needed. + - Rationalized the code that sets the glyph/ii dirty flags so that + it always properly propagates the flags up the ii to the glyph and + from there to the proper glyphs_changed flags. #### We don't + properly turn these flags off (it happens too soon, e.g.), due to + problems with the glyph cachels. + - We now notice when an instantiator in a glyph has changed and + set the appropriate changed flags (formerly we did this only for + built-in glyphs). This makes the progress-gauge test code in + tests/glyph-tests.el work properly. + + - i've added functions to traipse up and down an image instance + hierarchy, and internally modified the widget code to keep track + of a list of image instances as the children [as it logically + should] instead of a list of internally-created glyphs whose + only purpose is to encapsulate the image instance and simplify + making changes [i added some code that lets you "overwrite" an + existing image instance in the same way as would happen before + by instantiating the internal glyph, but in a more predictable + fashion]. this way, we are more certain that we keep the same + image instance object as much as is possible when making + changes, and when you want to get the children of an image + instance, you directly get a list of image instances. + + - i'm in the process of changing widget instantiators to be + instantiator objects rather than vectors -- something i + described to you awhile ago. you may have seen a recent post + giving the api. i'm also in the process of implementing + set-image-instance-property, which lets you make temporary + changes that only affect the current image instance -- e.g. you + set the text in the text field, which affects only that + particular dialog box and not any others that may be currently + displayed or displayed in the future. [you change the + instantiator if you want such a permanent change. with the + instantiator objects, there's a reasonable way of doing this, + and the changes will automatically be noticed instead of + requiring lots of vector structure comparisons.] + + - Many primitives now exist for the operations described in the + previous two paragraphs -- working with instantiator objects, + traipsing through a tree of such objects or a tree of image + instances, setting properties of instantiators or image + instances, etc. The documentation clearly explains the + difference between setting a property of an image instance and + an instantiator object. + + ------------- Keyword changes -------------- + + - Internally we now support subrs with keywords, through + DEFUN_WITH_KEYWORD. You have options you can set -- + allow-other-keys and/or default-unbound. (The former allows you to + accept keywords other than you're specifically declared for; the + latter makes the default values of the keyword arguments be + Qunbound rather than Qnil, so you can implement your own default + values -- keywords in general should be able to have default + values other than nil.) This works quite nicely -- you get as many + args in your function as you have of either normal or keyword + args, and with allow-other-keys, you get two more, an integer + and Lisp_Object_Pair array of the other keys and their values. + + Note that the keyword support here does NOT exactly follow Common + Lisp. Besides some missing CL features, we handle differently the + interaction between optional args and keywords. If you declare a + function with both optional args and keywords, and leave out some + of the optional args but give keywords, CL will automatically + start sticking the keywords and their arguments into the optional + args -- something you almost never want. We instead try to do the + most sensible, which is tricky: (a) if there are an odd number of + arguments left, the first one goes to the first optional arg, and + continue; (b) if the next argument is a keyword and it's an + allowed keyword, we default the rest of the optional args and + start keyword processing; otherwise we store into the optional arg + and proceed. This feels a bit hackish but it will generally do + the right thing in a very important situation -- we have some + function with an optional arg, and we want to add a bunch more + arguments to it -- just adding them as normal arguments creates + long, difficult to parse function calls and creates possible + conflicts with GNU Emacs. Using keywords solves both of these -- + but having to specify nil for all the optional arguments (the CL + way) is tedious and error-prone, especially since we may later go + back and add another optional argument, thus breaking all code + that had to follow the CL way. + + - #### What we need to do is modify the code in cl.el that handles + keywords to implement our way of handling optional args with + keywords. Perhaps we need a flag where the user can select + globally whether CL or new-XEmacs semantics apply to keywords, and + there could be lambda-list-keywords that could be given to + indicate one way or the other. We also need to integrate things a + bit more -- defun* gives full CL defun semantics with keywords, + an implicit block, etc. This should probably be called just + defun. In any case, the help system needs to correctly + recognize such expanded defuns and get their arg lists right. + + - modified make-docfile.c to handle keyword args. also added + support for seeing the arglist of subr special forms, e.g. + condition-case or unwind-protect. + + ------------- Hash tables -------------- + + - The weakness type is now a weak-mark function, passed each + key/value pair in turn as the code in + finish_marking_weak_hash_tables() iterates over each entry in a + weak hash table. The function uses marked_p() to check whether an + object is marked, and if it decides that the entry should stay, it + does something like `return mark_object_if_not (e->key) + return + mark_object_if_not (e->value); otherwise, it does nothing and + returns 0, and the entry will be removed. This allows user-defined + weak-behavior in weak hash tables. Used in the glyph subcontrol + caches. + + - elisp_maphash_unsafe() now handles weak tables by + brute-forcefully disabling GC around the mapping. + + ------------- Internal changes -------------- + + - More byte-or-string inlines/macros to support code that works + with either. + - Some renamings -- BUF_FETCH_CHAR -> BUF_EMCHAR_AT, similarly + charptr_emchar() -> charptr_emchar_at(). + 2005-02-04 Vin Shelton <acs(a)xemacs.org&gt; * lread.c (check_if_suppressed, check_if_suppressed): 1.27.4.1 +8 -9 XEmacs/xemacs/src/EmacsFrame.c Index: EmacsFrame.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/EmacsFrame.c,v retrieving revision 1.27 retrieving revision 1.27.4.1 diff -u -r1.27 -r1.27.4.1 --- EmacsFrame.c 2005/01/24 23:33:45 1.27 +++ EmacsFrame.c 2005/02/16 00:42:37 1.27.4.1 ＠＠ -53,8 +53,7 ＠＠ static XtGeometryResult EmacsFrameQueryGeometry (Widget, XtWidgetGeometry*, XtWidgetGeometry*); -extern void -emacs_Xt_mapping_action (Widget w, XEvent* event); +extern void Xt_mapping_action (Widget w, XEvent* event); #undef XtOffset #define XtOffset(p_type,field) \ ＠＠ -181,7 +180,7 ＠＠ static XtActionsRec emacsFrameActionsTable [] = { - {"mapping", (XtActionProc) emacs_Xt_mapping_action}, + {"mapping", (XtActionProc) Xt_mapping_action}, }; static char ＠＠ -279,10 +278,10 ＠＠ ew->emacs_frame.internal_border_width; } -void emacs_Xt_event_handler (Widget wid /* unused */, - XtPointer closure /* unused */, - XEvent *event, - Boolean *continue_to_dispatch /* unused */); +void Xt_event_handler (Widget wid /* unused */, + XtPointer closure /* unused */, + XEvent *event, + Boolean *continue_to_dispatch /* unused */); static void EmacsFrameRealize (Widget widget, XtValueMask *mask, ＠＠ -322,7 +321,7 ＠＠ /* snarf the events we want. */ XtInsertEventHandler (widget, attrs->event_mask, TRUE, - emacs_Xt_event_handler, NULL, XtListHead); + Xt_event_handler, NULL, XtListHead); /* some events (e.g. map-notify and WM_DELETE_WINDOW) get sent directly to the shell, and the above event handler won't see them. So add a handler to get them. These events don't ＠＠ -331,7 +330,7 ＠＠ EnterWindowMask | LeaveWindowMask | VisibilityChangeMask | StructureNotifyMask | KeyPressMask, - TRUE, emacs_Xt_event_handler, NULL, XtListHead); + TRUE, Xt_event_handler, NULL, XtListHead); #ifdef EXTERNAL_WIDGET /* #### Not sure if this special case is necessary */ 1.7.6.1 +3 -2 XEmacs/xemacs/src/ExternalShell.c Index: ExternalShell.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/ExternalShell.c,v retrieving revision 1.7 retrieving revision 1.7.6.1 diff -u -r1.7 -r1.7.6.1 --- ExternalShell.c 2004/09/22 03:04:44 1.7 +++ ExternalShell.c 2005/02/16 00:42:38 1.7.6.1 ＠＠ -1,5 +1,6 ＠＠ /* External shell widget. Copyright (C) 1993, 1994 Sun Microsystems, Inc. + Copyright (C) 2002 Ben Wing. This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public ＠＠ -629,8 +630,8 ＠＠ } } -/* fix all event masks on all subwindows of the specified window so that - all key presses in any subwindow filter up to the specified window. +/* fix all event masks on all children of the specified window so that + all key presses in any child filter up to the specified window. We have to do this cruftiness with external widgets so that we don't step on Motif's concept of keyboard focus. (Due to the nature of 1.114.4.1 +6 -2 XEmacs/xemacs/src/Makefile.in.in Index: Makefile.in.in =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/Makefile.in.in,v retrieving revision 1.114 retrieving revision 1.114.4.1 diff -u -r1.114 -r1.114.4.1 --- Makefile.in.in 2005/01/26 03:40:15 1.114 +++ Makefile.in.in 2005/02/16 00:42:38 1.114.4.1 ＠＠ -3,7 +3,7 ＠＠ ## Copyright (C) 1994, 1995 Board of Trustees, University of Illinois ## Copyright (C) 1996, 1997 Sun Microsystems, Inc. ## Copyright (C) 1998, 1999 J. Kean Johnston. -## Copyright (C) 2001, 2002, 2003 Ben Wing. +## Copyright (C) 2001, 2002, 2003, 2005 Ben Wing. ## This file is part of XEmacs. ＠＠ -160,6 +160,10 ＠＠ #endif #endif +#ifdef HAVE_XLIKE /* X or GTK */ +xlike_objs=redisplay-xlike.o +#endif + #ifdef HAVE_BALLOON_HELP balloon_help_objs=balloon_help.o balloon-x.o #endif ＠＠ -281,7 +285,7 ＠＠ search.o select.o $(sheap_objs) $(shlib_objs) signal.o sound.o\ specifier.o strftime.o $(sunpro_objs) symbols.o syntax.o sysdep.o\ text.o $(tooltalk_objs) $(tty_objs) undo.o unicode.o $(x_objs) $(x_gui_objs)\ - widget.o window.o $(win32_objs) + $(xlike_objs) widget.o window.o $(win32_objs) obj_rtl = $(objs:.o=.c.rtl) 1.20.6.1 +7 -7 XEmacs/xemacs/src/abbrev.c Index: abbrev.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/abbrev.c,v retrieving revision 1.20 retrieving revision 1.20.6.1 diff -u -r1.20 -r1.20.6.1 --- abbrev.c 2004/11/04 23:06:15 1.20 +++ abbrev.c 2005/02/16 00:42:39 1.20.6.1 ＠＠ -115,9 +115,9 ＠＠ normally want to expand it. OTOH, if the abbrev begins with non-word syntax (e.g. `#if'), it is OK to abbreviate it anywhere. */ if (abbrev_length < closure->maxlen && abbrev_length > 0 - && (WORD_SYNTAX_P (closure->chartab, string_ichar (abbrev, 0))) + && (WORD_SYNTAX_P (closure->chartab, string_ichar_at (abbrev, 0))) && (WORD_SYNTAX_P (closure->chartab, - BUF_FETCH_CHAR (closure->buf, + BUF_ICHAR_AT (closure->buf, closure->point - (abbrev_length + 1))))) { ＠＠ -131,7 +131,7 ＠＠ for (idx = 0; idx < abbrev_length; idx++) { if (DOWNCASE (closure->buf, - BUF_FETCH_CHAR (closure->buf, + BUF_ICHAR_AT (closure->buf, closure->point - abbrev_length + idx)) != DOWNCASE (closure->buf, itext_ichar (ptr))) { ＠＠ -199,7 +199,7 ＠＠ indicate the abbrev start point. It now uses an extent with a begin glyph so there's no dash to remove. */ if (wordstart != BUF_ZV (buf) - && BUF_FETCH_CHAR (buf, wordstart) == '-') + && BUF_ICHAR_AT (buf, wordstart) == '-') { buffer_delete_range (buf, wordstart, wordstart + 1, 0); } ＠＠ -234,7 +234,7 ＠＠ p = word = alloca_ibytes (MAX_ICHAR_LEN * (wordend - wordstart)); for (idx = wordstart; idx < wordend; idx++) { - Ichar c = BUF_FETCH_CHAR (buf, idx); + Ichar c = BUF_ICHAR_AT (buf, idx); if (UPPERCASEP (buf, c)) c = DOWNCASE (buf, c); p += set_itext_ichar (p, c); ＠＠ -261,7 +261,7 ＠＠ *lccount = *uccount = 0; while (length--) { - Ichar c = BUF_FETCH_CHAR (buf, pos); + Ichar c = BUF_ICHAR_AT (buf, pos); if (UPPERCASEP (buf, c)) ++*uccount; else if (LOWERCASEP (buf, c)) ＠＠ -388,7 +388,7 ＠＠ /* Find the initial. */ while (pos < point && !WORD_SYNTAX_P (buf->mirror_syntax_table, - BUF_FETCH_CHAR (buf, pos))) + BUF_ICHAR_AT (buf, pos))) pos++; /* Change just that. */ Fupcase_initials_region (make_int (pos), make_int (pos + 1), 1.106.4.1 +141 -55 XEmacs/xemacs/src/alloc.c Index: alloc.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/alloc.c,v retrieving revision 1.106 retrieving revision 1.106.4.1 diff -u -r1.106 -r1.106.4.1 --- alloc.c 2005/02/03 16:14:04 1.106 +++ alloc.c 2005/02/16 00:42:39 1.106.4.1 ＠＠ -1,7 +1,7 ＠＠ /* Storage allocation and gc for XEmacs Lisp interpreter. Copyright (C) 1985-1998 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1995, 1996, 2001, 2002, 2003, 2004 Ben Wing. + Copyright (C) 1995, 1996, 2001, 2002, 2003, 2004, 2005 Ben Wing. This file is part of XEmacs. ＠＠ -1096,6 +1096,7 ＠＠ Return a newly created list with specified arguments as elements. Any number of arguments, even zero arguments, are allowed. */ + /* (&rest args) */ (int nargs, Lisp_Object *args)) { Lisp_Object val = Qnil; ＠＠ -1427,6 +1428,7 ＠＠ Return a newly created vector with specified arguments as elements. Any number of arguments, even zero arguments, are allowed. */ + /* (&rest args) */ (int nargs, Lisp_Object *args)) { Lisp_Vector *vecp = make_vector_internal (nargs); ＠＠ -1554,6 +1556,8 ＠＠ Lisp_Bit_Vector *p = (Lisp_Bit_Vector *) basic_alloc_lcrecord (sizem, &lrecord_bit_vector); + INCREMENT_CONS_COUNTER (sizem, "bit-vector"); + bit_vector_length (p) = sizei; return p; } ＠＠ -1609,6 +1613,7 ＠＠ Any number of arguments, even zero arguments, are allowed. Each argument must be one of the integers 0 or 1. */ + /* (&rest bits) */ (int nargs, Lisp_Object *args)) { int i; ＠＠ -1658,8 +1663,6 ＠＠ DEFUN ("make-byte-code", Fmake_byte_code, 4, MANY, 0, /* Return a new compiled-function object. -Usage: (arglist instructions constants stack-depth - &optional doc-string interactive) Note that, unlike all other emacs-lisp functions, calling this with five arguments is NOT the same as calling it with six arguments, the last of which is nil. If the INTERACTIVE arg is specified as nil, then that means ＠＠ -1668,6 +1671,8 ＠＠ This is terrible behavior which is retained for compatibility with old `.elc' files which expect these semantics. */ + /* (arglist instructions constants stack-depth + &optional doc-string interactive) */ (int nargs, Lisp_Object *args)) { /* In a non-insane world this function would have this arglist... ＠＠ -1968,23 +1973,71 ＠＠ return wrap_eval_data (d); } -DECLARE_FIXED_TYPE_ALLOC (misc_user_data, Lisp_Misc_User_Data); -#define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_misc_user_data 1000 +DECLARE_FIXED_TYPE_ALLOC (activate_data, Lisp_Activate_Data); +#define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_activate_data 1000 Lisp_Object -make_misc_user_data (void) +make_activate_data (void) { - Lisp_Misc_User_Data *d; + Lisp_Activate_Data *d; - ALLOCATE_FIXED_TYPE (misc_user_data, Lisp_Misc_User_Data, d); + ALLOCATE_FIXED_TYPE (activate_data, Lisp_Activate_Data, d); xzero (*d); - set_lheader_implementation (&d->lheader, &lrecord_misc_user_data); - d->function = Qnil; - d->object = Qnil; + set_lheader_implementation (&d->lheader, &lrecord_activate_data); + d->text = Qnil; + d->callback = Qnil; + + return wrap_activate_data (d); +} + +DECLARE_FIXED_TYPE_ALLOC (scrollbar_data, Lisp_Scrollbar_Data); +#define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_scrollbar_data 1000 + +Lisp_Object +make_scrollbar_data (void) +{ + Lisp_Scrollbar_Data *d; + + ALLOCATE_FIXED_TYPE (scrollbar_data, Lisp_Scrollbar_Data, d); + xzero (*d); + set_lheader_implementation (&d->lheader, &lrecord_scrollbar_data); + d->value = Qnil; + + return wrap_scrollbar_data (d); +} + +DECLARE_FIXED_TYPE_ALLOC (eval_data, Lisp_Drop_Data); +#define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_drop_data 1000 + +Lisp_Object +make_drop_data (void) +{ + Lisp_Drop_Data *d; + + ALLOCATE_FIXED_TYPE (drop_data, Lisp_Drop_Data, d); + xzero (*d); + set_lheader_implementation (&d->lheader, &lrecord_drop_data); + d->data_type = Qnil; + d->data = Qnil; - return wrap_misc_user_data (d); + return wrap_drop_data (d); } +DECLARE_FIXED_TYPE_ALLOC (notify_data, Lisp_Notify_Data); +#define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_notify_data 1000 + +Lisp_Object +make_notify_data (void) +{ + Lisp_Notify_Data *d; + + ALLOCATE_FIXED_TYPE (notify_data, Lisp_Notify_Data, d); + xzero (*d); + set_lheader_implementation (&d->lheader, &lrecord_notify_data); + + return wrap_notify_data (d); +} + #endif /* EVENT_DATA_AS_OBJECTS */  /************************************************************************/ ＠＠ -2241,7 +2294,7 ＠＠ for (i = 0; i < XSTRING_LENGTH (str); i++) { - if (!byte_ascii_p (string_byte (str, i))) + if (!byte_ascii_p (string_byte_at (str, i))) break; } ＠＠ -2276,7 +2329,7 ＠＠ set_lispstringp_length (s, length); s->plist = Qnil; - set_string_byte (wrap_string (s), length, 0); + set_string_byte_at (wrap_string (s), length, 0); return wrap_string (s); } ＠＠ -2518,6 +2571,7 ＠＠ DEFUN ("string", Fstring, 0, MANY, 0, /* Concatenate all the argument characters and make the result a string. */ + /* (&rest chars) */ (int nargs, Lisp_Object *args)) { Ibyte *storage = alloca_ibytes (nargs * MAX_ICHAR_LEN); ＠＠ -3031,14 +3085,15 ＠＠ #endif /* not DEBUG_XEMACS */ #ifdef ERROR_CHECK_GC -#define GC_CHECK_LHEADER_INVARIANTS(lheader) do { \ - struct lrecord_header * GCLI_lh = (lheader); \ - assert (GCLI_lh != 0); \ - assert (GCLI_lh->type < (unsigned int) lrecord_type_count); \ - assert (! C_READONLY_RECORD_HEADER_P (GCLI_lh) || \ - (MARKED_RECORD_HEADER_P (GCLI_lh) && \ - LISP_READONLY_RECORD_HEADER_P (GCLI_lh))); \ -} while (0) +void +GC_CHECK_LHEADER_INVARIANTS (struct lrecord_header *lheader) +{ + assert (lheader != 0); + assert (lheader->type < (unsigned int) lrecord_type_count); + assert (! C_READONLY_RECORD_HEADER_P (lheader) || + (MARKED_RECORD_HEADER_P (lheader) && + LISP_READONLY_RECORD_HEADER_P (lheader))); +} #else #define GC_CHECK_LHEADER_INVARIANTS(lheader) #endif ＠＠ -4120,20 +4175,65 ＠＠ } static void -sweep_misc_user_data (void) +sweep_activate_data (void) { -#define UNMARK_misc_user_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) -#define ADDITIONAL_FREE_misc_user_data(ptr) +#define UNMARK_activate_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) +#define ADDITIONAL_FREE_activate_data(ptr) - SWEEP_FIXED_TYPE_BLOCK (misc_user_data, Lisp_Misc_User_Data); + SWEEP_FIXED_TYPE_BLOCK (activate_data, Lisp_Activate_Data); } void -free_misc_user_data (Lisp_Object ptr) +free_activate_data (Lisp_Object ptr) { - FREE_FIXED_TYPE_WHEN_NOT_IN_GC (misc_user_data, Lisp_Misc_User_Data, XMISC_USER_DATA (ptr)); + FREE_FIXED_TYPE_WHEN_NOT_IN_GC (activate_data, Lisp_Activate_Data, XACTIVATE_DATA (ptr)); } +static void +sweep_scrollbar_data (void) +{ +#define UNMARK_scrollbar_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) +#define ADDITIONAL_FREE_scrollbar_data(ptr) + + SWEEP_FIXED_TYPE_BLOCK (scrollbar_data, Lisp_Scrollbar_Data); +} + +void +free_scrollbar_data (Lisp_Object ptr) +{ + FREE_FIXED_TYPE_WHEN_NOT_IN_GC (scrollbar_data, Lisp_Scrollbar_Data, XSCROLLBAR_DATA (ptr)); +} + +static void +sweep_drop_data (void) +{ +#define UNMARK_drop_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) +#define ADDITIONAL_FREE_drop_data(ptr) + + SWEEP_FIXED_TYPE_BLOCK (drop_data, Lisp_Drop_Data); +} + +void +free_drop_data (Lisp_Object ptr) +{ + FREE_FIXED_TYPE_WHEN_NOT_IN_GC (drop_data, Lisp_Drop_Data, XDROP_DATA (ptr)); +} + +static void +sweep_eval_data (void) +{ +#define UNMARK_notify_data(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) +#define ADDITIONAL_FREE_notify_data(ptr) + + SWEEP_FIXED_TYPE_BLOCK (notify_data, Lisp_Notify_Data); +} + +void +free_notify_data (Lisp_Object ptr) +{ + FREE_FIXED_TYPE_WHEN_NOT_IN_GC (notify_data, Lisp_Notify_Data, XNOTIFY_DATA (ptr)); +} + #endif /* EVENT_DATA_AS_OBJECTS */ static void ＠＠ -4315,7 +4415,7 ＠＠ stderr_out ("\""); for (i = 0; i < s; i++) { - Ichar ch = string_ichar (p, i); + Ichar ch = string_ichar_at (p, i); if (ch < 32 || ch >= 126) stderr_out ("\\%03o", ch); else if (ch == '\\' || ch == '\"') ＠＠ -4361,27 +4461,6 ＠＠ gc_count_short_string_total_size = num_small_bytes; } - -/* I hate duplicating all this crap! */ -int -marked_p (Lisp_Object obj) -{ - /* Checks we used to perform. */ - /* if (EQ (obj, Qnull_pointer)) return 1; */ - /* if (!POINTER_TYPE_P (XGCTYPE (obj))) return 1; */ - /* if (PURIFIED (XPNTR (obj))) return 1; */ - - if (XTYPE (obj) == Lisp_Type_Record) - { - struct lrecord_header *lheader = XRECORD_LHEADER (obj); - - GC_CHECK_LHEADER_INVARIANTS (lheader); - - return MARKED_RECORD_HEADER_P (lheader); - } - return 1; -} - static void gc_sweep (void) { ＠＠ -4457,7 +4536,10 ＠＠ sweep_magic_data (); sweep_magic_eval_data (); sweep_eval_data (); - sweep_misc_user_data (); + sweep_activate_data (); + sweep_scrollbar_data (); + sweep_drop_data (); + sweep_notify_data (); #endif /* EVENT_DATA_AS_OBJECTS */ #ifdef PDUMP ＠＠ -4662,9 +4744,10 ＠＠ if (FRAME_WIN_P (f)) { Lisp_Object frame = wrap_frame (f); - Lisp_Object cursor = glyph_image_instance (Vgc_pointer_glyph, - FRAME_SELECTED_WINDOW (f), - ERROR_ME_NOT, 1); + Lisp_Object cursor = + glyph_image_instance (Vgc_pointer_glyph, + FRAME_SELECTED_WINDOW (f), + Qunbound, ERROR_ME_NOT, 1); pre_gc_cursor = f->pointer; if (POINTER_IMAGE_INSTANCEP (cursor) /* don't change if we don't know how to change back. */ ＠＠ -5317,7 +5400,10 ＠＠ init_magic_data_alloc (); init_magic_eval_data_alloc (); init_eval_data_alloc (); - init_misc_user_data_alloc (); + init_activate_data_alloc (); + init_scrollbar_data_alloc (); + init_drop_data_alloc (); + init_notify_data_alloc (); #endif /* EVENT_DATA_AS_OBJECTS */ ignore_malloc_warnings = 0; 1.70.4.1 +4 -4 XEmacs/xemacs/src/buffer.c Index: buffer.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/buffer.c,v retrieving revision 1.70 retrieving revision 1.70.4.1 diff -u -r1.70 -r1.70.4.1 --- buffer.c 2005/02/03 16:14:04 1.70 +++ buffer.c 2005/02/16 00:42:41 1.70.4.1 ＠＠ -610,7 +610,7 ＠＠ b->last_window_start = 1; b->name = name; - if (string_byte (name, 0) != ' ') + if (string_byte_at (name, 0) != ' ') b->undo_list = Qnil; else b->undo_list = Qt; ＠＠ -626,7 +626,7 ＠＠ init_buffer_syntax_cache (b); b->generated_modeline_string = Fmake_string (make_int (84), make_int (' ')); - b->modeline_extent_table = make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK, + b->modeline_extent_table = make_lisp_hash_table (20, hash_table_key_weak, HASH_TABLE_EQ); ＠＠ -1060,7 +1060,7 ＠＠ buf = Fcdr (Fcar (tail)); if (EQ (buf, buffer)) continue; - if (string_byte (XBUFFER (buf)->name, 0) == ' ') + if (string_byte_at (XBUFFER (buf)->name, 0) == ' ') continue; /* If FRAME has a buffer_predicate, disregard buffers that don't fit the predicate. */ ＠＠ -2114,7 +2114,7 ＠＠ /* The docstrings for DEFVAR_* are recorded externally by make-docfile. */ /* Renamed from DEFVAR_PER_BUFFER because FSFmacs D_P_B takes - a bogus extra arg, which confuses an otherwise identical make-docfile.c */ + a bogus extra arg */ #define DEFVAR_BUFFER_LOCAL_1(lname, field_name, forward_type, magicfun) do { \ static const struct symbol_value_forward I_hate_C = \ { /* struct symbol_value_forward */ \ 1.31.6.1 +252 -104 XEmacs/xemacs/src/buffer.h Index: buffer.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/buffer.h,v retrieving revision 1.31 retrieving revision 1.31.6.1 diff -u -r1.31 -r1.31.6.1 --- buffer.h 2004/11/04 23:06:16 1.31 +++ buffer.h 2005/02/16 00:42:42 1.31.6.1 ＠＠ -223,7 +223,7 ＠＠ Do NOT mark through this. */ Lisp_Object indirect_children; - /* Flags saying which DEFVAR_PER_BUFFER variables + /* Flags saying which DEFVAR_BUFFER_LOCAL variables are local to this buffer. */ int local_var_flags; ＠＠ -691,101 +691,6 ＠＠ } /*----------------------------------------------------------------------*/ -/* Generalized buffer/string position convertors */ -/*----------------------------------------------------------------------*/ - -/* These macros generalize many standard buffer-position functions to - either a buffer or a string. */ - -/* Converting between Memxpos's and Bytexpos's, for a buffer-or-string. - For strings, this is a no-op. For buffers, this resolves - to the standard membpos<->bytebpos converters. */ - -DECLARE_INLINE_HEADER ( -Memxpos buffer_or_string_bytexpos_to_memxpos (Lisp_Object obj, Bytexpos pos) -) -{ - return (BUFFERP (obj) ? bytebpos_to_membpos (XBUFFER (obj), pos) : - (Memxpos) pos); -} - -DECLARE_INLINE_HEADER ( -Bytexpos buffer_or_string_memxpos_to_bytexpos (Lisp_Object obj, Memxpos pos) -) -{ - return (BUFFERP (obj) ? membpos_to_bytebpos (XBUFFER (obj), pos) : - (Bytexpos) pos); -} - -/* Converting between Charxpos's and Bytexpos's, for a buffer-or-string. - For strings, this maps to the bytecount<->charcount converters. */ - -DECLARE_INLINE_HEADER ( -Bytexpos buffer_or_string_charxpos_to_bytexpos (Lisp_Object obj, Charxpos pos) -) -{ - return (BUFFERP (obj) ? charbpos_to_bytebpos (XBUFFER (obj), pos) : - (Bytexpos) string_index_char_to_byte (obj, pos)); -} - -DECLARE_INLINE_HEADER ( -Charxpos buffer_or_string_bytexpos_to_charxpos (Lisp_Object obj, Bytexpos pos) -) -{ - return (BUFFERP (obj) ? bytebpos_to_charbpos (XBUFFER (obj), pos) : - (Charxpos) string_index_byte_to_char (obj, pos)); -} - -/* Similar for Charxpos's and Memxpos's. */ - -DECLARE_INLINE_HEADER ( -Memxpos buffer_or_string_charxpos_to_memxpos (Lisp_Object obj, Charxpos pos) -) -{ - return (BUFFERP (obj) ? charbpos_to_membpos (XBUFFER (obj), pos) : - (Memxpos) string_index_char_to_byte (obj, pos)); -} - -DECLARE_INLINE_HEADER ( -Charxpos buffer_or_string_memxpos_to_charxpos (Lisp_Object obj, Memxpos pos) -) -{ - return (BUFFERP (obj) ? membpos_to_charbpos (XBUFFER (obj), pos) : - (Charxpos) string_index_byte_to_char (obj, pos)); -} - -DECLARE_INLINE_HEADER ( -Internal_Format buffer_or_other_internal_format (Lisp_Object obj) -) -{ - return BUFFERP (obj) ? BUF_FORMAT (XBUFFER (obj)) : FORMAT_DEFAULT; -} - -/* Return the index to the character before the one at X, - in a buffer or string. */ - -DECLARE_INLINE_HEADER ( -Bytebpos -prev_bytexpos (Lisp_Object obj, Bytebpos x) -) -{ - return BUFFERP (obj) ? prev_bytebpos (XBUFFER (obj), x) : - prev_string_index (obj, x); -} - -/* Return the index to the character after the one at X, - in a buffer or string. */ - -DECLARE_INLINE_HEADER ( -Bytebpos -next_bytexpos (Lisp_Object obj, Bytebpos x) -) -{ - return BUFFERP (obj) ? next_bytebpos (XBUFFER (obj), x) : - next_string_index (obj, x); -} - -/*----------------------------------------------------------------------*/ /* Converting between positions and addresses */ /*----------------------------------------------------------------------*/ ＠＠ -839,28 +744,28 ＠＠ /* The character at position POS in buffer. */ -#define BYTE_BUF_FETCH_CHAR(buf, pos) \ +#define BYTE_BUF_ICHAR_AT(buf, pos) \ itext_ichar_fmt (BYTE_BUF_BYTE_ADDRESS (buf, pos), BUF_FORMAT (buf), \ wrap_buffer (buf)) -#define BUF_FETCH_CHAR(buf, pos) \ - BYTE_BUF_FETCH_CHAR (buf, charbpos_to_bytebpos (buf, pos)) +#define BUF_ICHAR_AT(buf, pos) \ + BYTE_BUF_ICHAR_AT (buf, charbpos_to_bytebpos (buf, pos)) /* The "raw value" of the character at position POS in buffer. See ichar_to_raw(). */ -#define BYTE_BUF_FETCH_CHAR_RAW(buf, pos) \ +#define BYTE_BUF_ICHAR_AT_RAW(buf, pos) \ itext_ichar_raw_fmt (BYTE_BUF_BYTE_ADDRESS (buf, pos), BUF_FORMAT (buf)) -#define BUF_FETCH_CHAR_RAW(buf, pos) \ - BYTE_BUF_FETCH_CHAR_RAW (buf, charbpos_to_bytebpos (buf, pos)) +#define BUF_ICHAR_AT_RAW(buf, pos) \ + BYTE_BUF_ICHAR_AT_RAW (buf, charbpos_to_bytebpos (buf, pos)) /* The character at position POS in buffer, as a string. This is - equivalent to set_itext_ichar (str, BUF_FETCH_CHAR (buf, pos)) + equivalent to set_itext_ichar (str, BUF_ICHAR_AT (buf, pos)) but is faster for Mule. */ # define BYTE_BUF_ITEXT_COPY_ICHAR(buf, pos, str) \ (BUF_FORMAT (buf) == FORMAT_DEFAULT ? \ itext_copy_ichar (BYTE_BUF_BYTE_ADDRESS (buf, pos), str) : \ - set_itext_ichar (str, BYTE_BUF_FETCH_CHAR (buf, pos))) + set_itext_ichar (str, BYTE_BUF_ICHAR_AT (buf, pos))) #define BUF_ITEXT_COPY_ICHAR(buf, pos, str) \ BYTE_BUF_ITEXT_COPY_ICHAR (buf, charbpos_to_bytebpos (buf, pos), str) ＠＠ -1138,6 +1043,249 ＠＠ #define R_ALLOC_DECLARE(var,data) #endif /* !REL_ALLOC */ + + +/************************************************************************/ +/* Generalized buffer/string routines */ +/************************************************************************/ + +/* "Textobj" is shorthand for a buffer or string -- i.e. any object that + holds text. Many functions can work equally well with both, so we need + utility functions to simplify this. Making them inline speeds things up + and may even allow an optimizing compiler to extract the check for buffer + vs. string out of an inner loop. #### In order to make this a realistic + possibility, we need the type field declared as const so that the compiler + can assume that functions called on the object don't change its type field. + This will be easier when we move to C++. */ + +/*----------------------------------------------------------------------*/ +/* Textobj position convertors */ +/*----------------------------------------------------------------------*/ + +/* These macros generalize many standard buffer-position functions to + either a buffer or a string. */ + +/* Converting between Memxpos's and Bytexpos's, for a buffer-or-string. + For strings, this is a no-op. For buffers, this resolves + to the standard membpos<->bytebpos converters. */ + +DECLARE_INLINE_HEADER ( +Memxpos textobj_bytexpos_to_memxpos (Lisp_Object obj, Bytexpos pos) +) +{ + return (BUFFERP (obj) ? bytebpos_to_membpos (XBUFFER (obj), pos) : + (Memxpos) pos); +} + +DECLARE_INLINE_HEADER ( +Bytexpos textobj_memxpos_to_bytexpos (Lisp_Object obj, Memxpos pos) +) +{ + return (BUFFERP (obj) ? membpos_to_bytebpos (XBUFFER (obj), pos) : + (Bytexpos) pos); +} + +/* Converting between Charxpos's and Bytexpos's, for a buffer-or-string. + For strings, this maps to the bytecount<->charcount converters. */ + +DECLARE_INLINE_HEADER ( +Bytexpos textobj_charxpos_to_bytexpos (Lisp_Object obj, Charxpos pos) +) +{ + return (BUFFERP (obj) ? charbpos_to_bytebpos (XBUFFER (obj), pos) : + (Bytexpos) string_index_char_to_byte (obj, pos)); +} + +DECLARE_INLINE_HEADER ( +Charxpos textobj_bytexpos_to_charxpos (Lisp_Object obj, Bytexpos pos) +) +{ + return (BUFFERP (obj) ? bytebpos_to_charbpos (XBUFFER (obj), pos) : + (Charxpos) string_index_byte_to_char (obj, pos)); +} + +/* Similar for Charxpos's and Memxpos's. */ + +DECLARE_INLINE_HEADER ( +Memxpos textobj_charxpos_to_memxpos (Lisp_Object obj, Charxpos pos) +) +{ + return (BUFFERP (obj) ? charbpos_to_membpos (XBUFFER (obj), pos) : + (Memxpos) string_index_char_to_byte (obj, pos)); +} + +DECLARE_INLINE_HEADER ( +Charxpos textobj_memxpos_to_charxpos (Lisp_Object obj, Memxpos pos) +) +{ + return (BUFFERP (obj) ? membpos_to_charbpos (XBUFFER (obj), pos) : + (Charxpos) string_index_byte_to_char (obj, pos)); +} + +DECLARE_INLINE_HEADER ( +Internal_Format buffer_or_other_internal_format (Lisp_Object obj) +) +{ + return BUFFERP (obj) ? BUF_FORMAT (XBUFFER (obj)) : FORMAT_DEFAULT; +} + +/*----------------------------------------------------------------------*/ +/* Textobj beginning/end values */ +/*----------------------------------------------------------------------*/ + +DECLARE_INLINE_HEADER ( +Charxpos +textobj_accessible_begin_char (Lisp_Object object) +) +{ + return BUFFERP (object) ? BUF_BEGV (XBUFFER (object)) : 0; +} + +DECLARE_INLINE_HEADER ( +Charxpos +textobj_accessible_end_char (Lisp_Object object) +) +{ + return BUFFERP (object) ? BUF_ZV (XBUFFER (object)) : + string_char_length (object); +} + +DECLARE_INLINE_HEADER ( +Bytexpos +textobj_accessible_begin_byte (Lisp_Object object) +) +{ + return BUFFERP (object) ? BYTE_BUF_BEGV (XBUFFER (object)) : 0; +} + +DECLARE_INLINE_HEADER ( +Bytexpos +textobj_accessible_end_byte (Lisp_Object object) +) +{ + return BUFFERP (object) ? BYTE_BUF_ZV (XBUFFER (object)) : + XSTRING_LENGTH (object); +} + +DECLARE_INLINE_HEADER ( +Charxpos +textobj_absolute_begin_char (Lisp_Object object) +) +{ + return BUFFERP (object) ? BUF_BEG (XBUFFER (object)) : 0; +} + +DECLARE_INLINE_HEADER ( +Charxpos +textobj_absolute_end_char (Lisp_Object object) +) +{ + return BUFFERP (object) ? BUF_Z (XBUFFER (object)) : + string_char_length (object); +} + +DECLARE_INLINE_HEADER ( +Bytexpos +textobj_absolute_begin_byte (Lisp_Object object) +) +{ + return BUFFERP (object) ? BYTE_BUF_BEG (XBUFFER (object)) : 0; +} + +DECLARE_INLINE_HEADER ( +Bytexpos +textobj_absolute_end_byte (Lisp_Object object) +) +{ + return BUFFERP (object) ? BYTE_BUF_Z (XBUFFER (object)) : + XSTRING_LENGTH (object); +} + +/*----------------------------------------------------------------------*/ +/* Textobj working with positions */ +/*----------------------------------------------------------------------*/ + +/* Return the index to the character before the one at X, + in a buffer or string. */ + +DECLARE_INLINE_HEADER ( +Bytebpos +prev_bytexpos (Lisp_Object obj, Bytebpos x) +) +{ + return BUFFERP (obj) ? prev_bytebpos (XBUFFER (obj), x) : + prev_string_index (obj, x); +} + +/* Return the index to the character after the one at X, + in a buffer or string. */ + +DECLARE_INLINE_HEADER ( +Bytexpos +next_bytexpos (Lisp_Object obj, Bytexpos x) +) +{ + return BUFFERP (obj) ? next_bytebpos (XBUFFER (obj), x) : + next_string_index (obj, x); +} + +#define INC_BYTEXPOS(object, x) do \ +{ \ + Lisp_Object __inc_bytexpos_obj__ = (object); \ + if (BUFFERP (__inc_bytexpos_obj__)) \ + INC_BYTEBPOS (XBUFFER (__inc_bytexpos_obj__), x); \ + else \ + INC_BYTECOUNT (XSTRING_DATA (__inc_bytexpos_obj__), x); \ +} while (0) + +#define DEC_BYTEXPOS(object, x) do \ +{ \ + Lisp_Object __dec_bytexpos_obj__ = (object); \ + if (BUFFERP (__dec_bytexpos_obj__)) \ + DEC_BYTEBPOS (XBUFFER (__dec_bytexpos_obj__), x); \ + else \ + DEC_BYTECOUNT (XSTRING_DATA (__dec_bytexpos_obj__), x); \ +} while (0) + +/*----------------------------------------------------------------------*/ +/* Textobj retrieving characters */ +/*----------------------------------------------------------------------*/ + +DECLARE_INLINE_HEADER ( +Ichar +textobj_ichar_at_char (Lisp_Object object, Charxpos pos) +) +{ + return + BUFFERP (object) ? BUF_ICHAR_AT (XBUFFER (object), pos) : + string_ichar_at (object, pos); +} + +DECLARE_INLINE_HEADER ( +Ichar +textobj_ichar_at_byte (Lisp_Object object, Bytexpos pos) +) +{ + return + BUFFERP (object) ? BYTE_BUF_ICHAR_AT (XBUFFER (object), pos) : + string_ichar_at_byte (object, pos); +} + +/*----------------------------------------------------------------------*/ +/* Textobj searching for characters */ +/*----------------------------------------------------------------------*/ + +DECLARE_INLINE_HEADER ( +Ichar +textobj_byte_find_next_ichar_no_quit (Lisp_Object obj, Ichar target, + Bytexpos from, EMACS_INT count) +) +{ + return + BUFFERP (obj) ? byte_find_next_ichar_no_quit (XBUFFER (obj), target, from, + count) : + byte_find_next_ichar_in_string (obj, target, from, count); +}  /************************************************************************/ 1.29.6.1 +1 -0 XEmacs/xemacs/src/callint.c Index: callint.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/callint.c,v retrieving revision 1.29 retrieving revision 1.29.6.1 diff -u -r1.29 -r1.29.6.1 --- callint.c 2004/11/04 23:06:16 1.29 +++ callint.c 2005/02/16 00:42:43 1.29.6.1 ＠＠ -206,6 +206,7 ＠＠ `_' (setq zmacs-region-stays t) */ + /* (&optional string-or-expr) */ (UNUSED (args))) { return Qnil; 1.13.6.1 +1 -1 XEmacs/xemacs/src/casefiddle.c Index: casefiddle.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/casefiddle.c,v retrieving revision 1.13 retrieving revision 1.13.6.1 diff -u -r1.13 -r1.13.6.1 --- casefiddle.c 2004/11/04 23:06:16 1.13 +++ casefiddle.c 2005/02/16 00:42:43 1.13.6.1 ＠＠ -172,7 +172,7 ＠＠ for (pos = s; pos < e; pos++) { - Ichar oldc = BUF_FETCH_CHAR (buf, pos); + Ichar oldc = BUF_ICHAR_AT (buf, pos); Ichar c = oldc; switch (flag) 1.15.6.1 +1 -1 XEmacs/xemacs/src/casetab.c Index: casetab.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/casetab.c,v retrieving revision 1.15 retrieving revision 1.15.6.1 diff -u -r1.15 -r1.15.6.1 --- casetab.c 2004/09/20 19:19:35 1.15 +++ casetab.c 2005/02/16 00:42:44 1.15.6.1 ＠＠ -380,7 +380,7 ＠＠ Ichar i; for (i = 0; i < 256; i++) - SET_TRT_TABLE_OF (table, i, string_ichar (string, i)); + SET_TRT_TABLE_OF (table, i, string_ichar_at (string, i)); } static Lisp_Object 1.33.4.1 +1 -1 XEmacs/xemacs/src/chartab.c Index: chartab.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/chartab.c,v retrieving revision 1.33 retrieving revision 1.33.4.1 diff -u -r1.33 -r1.33.4.1 --- chartab.c 2005/01/24 23:33:47 1.33 +++ chartab.c 2005/02/16 00:42:44 1.33.4.1 ＠＠ -1651,7 +1651,7 ＠＠ CHECK_CATEGORY_DESIGNATOR (designator); des = XCHAR (designator); ctbl = check_category_table (category_table, buf->category_table); - ch = BUF_FETCH_CHAR (buf, XINT (position)); + ch = BUF_ICHAR_AT (buf, XINT (position)); return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil; } 1.17.10.1 +4 -4 XEmacs/xemacs/src/cmds.c Index: cmds.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/cmds.c,v retrieving revision 1.17 retrieving revision 1.17.10.1 diff -u -r1.17 -r1.17.10.1 --- cmds.c 2002/06/20 21:18:22 1.17 +++ cmds.c 2005/02/16 00:42:44 1.17.10.1 ＠＠ -156,7 +156,7 ＠＠ && (negp || (BUF_ZV (buf) > BUF_BEGV (buf) && pos != pos2 - && BUF_FETCH_CHAR (buf, pos - 1) != '\n'))) + && BUF_ICHAR_AT (buf, pos - 1) != '\n'))) shortage--; BUF_SET_PT (buf, pos); return make_int (negp ? - shortage : shortage); ＠＠ -391,9 +391,9 ＠＠ if (!NILP (overwrite) && BUF_PT (buf) < BUF_ZV (buf) && (EQ (overwrite, Qoverwrite_mode_binary) - || (c1 != '\n' && BUF_FETCH_CHAR (buf, BUF_PT (buf)) != '\n')) + || (c1 != '\n' && BUF_ICHAR_AT (buf, BUF_PT (buf)) != '\n')) && (EQ (overwrite, Qoverwrite_mode_binary) - || BUF_FETCH_CHAR (buf, BUF_PT (buf)) != '\t' + || BUF_ICHAR_AT (buf, BUF_PT (buf)) != '\t' || ((tab_width = XINT (buf->tab_width), tab_width <= 0) || tab_width > 20 || !((current_column (buf) + 1) % tab_width)))) ＠＠ -407,7 +407,7 ＠＠ && NILP (buf->read_only) && BUF_PT (buf) > BUF_BEGV (buf)) { - c2 = BUF_FETCH_CHAR (buf, BUF_PT (buf) - 1); + c2 = BUF_ICHAR_AT (buf, BUF_PT (buf) - 1); if (WORD_SYNTAX_P (syntax_table, c2)) { 1.96.4.1 +7 -8 XEmacs/xemacs/src/config.h.in Index: config.h.in =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/config.h.in,v retrieving revision 1.96 retrieving revision 1.96.4.1 diff -u -r1.96 -r1.96.4.1 --- config.h.in 2005/02/03 16:30:35 1.96 +++ config.h.in 2005/02/16 00:42:45 1.96.4.1 ＠＠ -1,6 +1,6 ＠＠ /* XEmacs site configuration template file. -*- C -*- Copyright (C) 1986, 1991-1994, 1998, 1999 Free Software Foundation, Inc. - Copyright (C) 2000, 2001, 2002, 2004 Ben Wing. + Copyright (C) 2000, 2001, 2002, 2004, 2005 Ben Wing. This file is part of XEmacs. ＠＠ -560,8 +560,7 ＠＠ debugging the byte compiler. */ #undef ERROR_CHECK_BYTE_CODE -/* Minor sanity checking of glyphs, especially subwindows and - widgets. */ +/* Minor sanity checking of glyphs, especially subcontrols. */ #undef ERROR_CHECK_GLYPHS /* Sanity-check the redisplay structures after each modification. */ ＠＠ -1054,15 +1053,15 ＠＠ #define USE_C_FONT_LOCK #ifdef ERROR_CHECK_ALL +#define ERROR_CHECK_BYTE_CODE +#define ERROR_CHECK_DISPLAY #define ERROR_CHECK_EXTENTS -#define ERROR_CHECK_TYPES -#define ERROR_CHECK_TEXT #define ERROR_CHECK_GC -#define ERROR_CHECK_MALLOC -#define ERROR_CHECK_BYTE_CODE #define ERROR_CHECK_GLYPHS -#define ERROR_CHECK_DISPLAY +#define ERROR_CHECK_MALLOC #define ERROR_CHECK_STRUCTURES +#define ERROR_CHECK_TEXT +#define ERROR_CHECK_TYPES #endif /* ERROR_CHECK_ALL */ #endif /* _SRC_CONFIG_H_ */ 1.5.6.1 +3 -2 XEmacs/xemacs/src/console-gtk-impl.h Index: console-gtk-impl.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/console-gtk-impl.h,v retrieving revision 1.5 retrieving revision 1.5.6.1 diff -u -r1.5 -r1.5.6.1 --- console-gtk-impl.h 2004/07/07 12:01:06 1.5 +++ console-gtk-impl.h 2005/02/16 00:42:45 1.5.6.1 ＠＠ -1,7 +1,7 ＠＠ /* Define GTK specific console, device, and frame object for XEmacs. Copyright (C) 1989, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. - Copyright (C) 2002 Ben Wing. + Copyright (C) 2002, 2005 Ben Wing. This file is part of XEmacs. ＠＠ -41,11 +41,12 ＠＠ #include "console-gtk.h" #include <X11/Xlib.h> -#define GDK_DRAWABLE(x) (GdkDrawable *) (x) +#define GDK_DRAWABLE(x) ((GdkDrawable *) (x)) #define GET_GTK_WIDGET_WINDOW(x) (GTK_WIDGET (x)->window) #define GET_GTK_WIDGET_PARENT(x) (GTK_WIDGET (x)->parent) DECLARE_CONSOLE_TYPE (gtk); +DECLARE_CONSOLE_TYPE (xlike); struct gtk_device { 1.5.6.1 +1 -1 XEmacs/xemacs/src/console-gtk.c Index: console-gtk.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/console-gtk.c,v retrieving revision 1.5 retrieving revision 1.5.6.1 diff -u -r1.5 -r1.5.6.1 --- console-gtk.c 2004/09/20 19:19:36 1.5 +++ console-gtk.c 2005/02/16 00:42:46 1.5.6.1 ＠＠ -115,7 +115,7 ＠＠ void console_type_create_gtk (void) { - INITIALIZE_CONSOLE_TYPE (gtk, "gtk", "console-gtk-p"); + INITIALIZE_CONSOLE_TYPE (gtk); CONSOLE_HAS_METHOD (gtk, semi_canonicalize_console_connection); CONSOLE_HAS_METHOD (gtk, canonicalize_console_connection); 1.9.6.1 +2 -11 XEmacs/xemacs/src/console-gtk.h Index: console-gtk.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/console-gtk.h,v retrieving revision 1.9 retrieving revision 1.9.6.1 diff -u -r1.9 -r1.9.6.1 --- console-gtk.h 2004/07/07 12:01:06 1.9 +++ console-gtk.h 2005/02/16 00:42:46 1.9.6.1 ＠＠ -57,17 +57,8 ＠＠ struct device *decode_gtk_device (Lisp_Object); void gtk_handle_property_notify (GdkEventProperty *event); -void signal_special_gtk_user_event (Lisp_Object channel, Lisp_Object function, - Lisp_Object object); -void gtk_output_string (struct window *w, struct display_line *dl, - Ichar_dynarr *buf, int xpos, int xoffset, - int start_pixpos, int width, face_index findex, - int cursor, int cursor_start, int cursor_width, - int cursor_height); -void gtk_output_shadows (struct frame *f, int x, int y, int width, - int height, int shadow_thickness); -GdkGC *gtk_get_gc (struct device *d, Lisp_Object font, Lisp_Object fg, Lisp_Object bg, - Lisp_Object bg_pmap, Lisp_Object lwidth); +GdkGC *gtk_get_gc (struct device *d, Lisp_Object font, Lisp_Object fg, + Lisp_Object bg, Lisp_Object bg_pmap, Lisp_Object lwidth); int gtk_initialize_frame_menubar (struct frame *f); void gtk_init_modifier_mapping (struct device *d); 1.8.4.1 +123 -29 XEmacs/xemacs/src/console-impl.h Index: console-impl.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/console-impl.h,v retrieving revision 1.8 retrieving revision 1.8.4.1 diff -u -r1.8 -r1.8.4.1 --- console-impl.h 2005/01/28 02:58:51 1.8 +++ console-impl.h 2005/02/16 00:42:46 1.8.4.1 ＠＠ -50,6 +50,14 ＠＠ /* Do not preempt resiaply of frame or device once it starts */ #define XDEVIMPF_DONT_PREEMPT_REDISPLAY 0x00000010L +struct textual_run +{ + Lisp_Object charset; + unsigned char *ptr; + int len; + int dimension; +}; + struct console_methods { const char *name; /* Used by print_console, print_device, print_frame */ ＠＠ -135,23 +143,34 ＠＠ void (*set_frame_icon_method) (struct frame *f); void (*popup_menu_method) (Lisp_Object menu, Lisp_Object event); Lisp_Object (*get_frame_parent_method) (struct frame *f); - void (*update_frame_external_traits_method) (struct frame *f, Lisp_Object name); + void (*update_frame_external_traits_method) (struct frame *f, + Lisp_Object name); int (*frame_size_fixed_p_method) (struct frame *f); void (*eject_page_method) (struct frame *f); /* redisplay methods */ int (*left_margin_width_method) (struct window *); int (*right_margin_width_method) (struct window *); + /* Given a string and a face, return the string's length in pixels when + displayed in the font associated with the face. */ int (*text_width_method) (struct frame *f, struct face_cachel *cachel, const Ichar *str, Charcount len); void (*output_display_block_method) (struct window *, struct display_line *, int, int, int, int, int, int, int); + /* Return the height of the horizontal divider. + + #### If we add etched horizontal divider lines this will have to get + smarter. + */ int (*divider_height_method) (void); + /* Return the width of the end-of-line cursor. */ int (*eol_cursor_width_method) (void); void (*output_vertical_divider_method) (struct window *, int); void (*clear_to_window_end_method) (struct window *, int, int); - void (*clear_region_method) (Lisp_Object, struct device*, struct frame*, face_index, - int, int, int, int, + /* Clear the area in the box defined by the given parameters using the + given face. */ + void (*clear_region_method) (Lisp_Object, struct device*, struct frame*, + face_index, int, int, int, int, Lisp_Object, Lisp_Object, Lisp_Object); void (*clear_frame_method) (struct frame *); void (*window_output_begin_method) (struct window *); ＠＠ -163,17 +182,52 ＠＠ int duration); void (*frame_redraw_cursor_method) (struct frame *f); void (*set_final_cursor_coords_method) (struct frame *, int, int); - void (*bevel_area_method) (struct window *, face_index, int, int, int, int, int, + void (*bevel_area_method) (struct window *, face_index, int, int, int, int, + int, int, enum edge_style); void (*output_pixmap_method) (struct window *w, Lisp_Object image_instance, - struct display_box *db, struct display_glyph_area *dga, - face_index findex, int cursor_start, int cursor_width, - int cursor_height, int offset_bitmap); + struct display_box *db, + struct display_glyph_area *dga, + face_index findex, int offset_bitmap); + +/***************************************************************************** + output_string_method + + Given a string and a starting position, output that string in the + given face. Correctly handles multiple charsets in the string. + + The meaning of the parameters is something like this: + + W Window that the text is to be displayed in. + DL Display line that this text is on. The values in the + structure are used to determine the vertical position and + clipping range of the text. + BUF Dynamic array of Ichars specifying what is actually to be + drawn. + XPOS X position in pixels where the text should start being drawn. + XOFFSET Number of pixels to be chopped off the left side of the + text. The effect is as if the text were shifted to the + left this many pixels and clipped at XPOS. + CLIP_START Clip everything left of this X position. + WIDTH Clip everything right of XPOS + WIDTH. + FINDEX Index for the face cache element describing how to display + the text. + ****************************************************************************/ + void (*output_string_method) (struct window *w, struct display_line *dl, Ichar_dynarr *buf, int xpos, int xoffset, - int start_pixpos, int width, face_index findex, - int cursor, int cursor_start, int cursor_width, - int cursor_height); + int start_pixpos, int width, + face_index findex); + void (*output_cursor_method) (struct window *w, struct display_line *dl, + int xpos, int width, face_index findex, + Ichar ch, int image_p); + /* Output a blank by clearing the area it covers in the foreground color + of its face. */ + void (*output_blank_method) (struct window *w, struct display_line *dl, + struct rune *rb, int start_pixpos); + /* Output a horizontal line in the foreground of its face. */ + void (*output_hline_method) (struct window *w, struct display_line *dl, + struct rune *rb); /* color methods */ int (*initialize_color_instance_method) (Lisp_Color_Instance *, ＠＠ -228,10 +282,9 ＠＠ Lisp_Object printcharfun, int escapeflag); void (*finalize_image_instance_method) (Lisp_Image_Instance *); - void (*unmap_subwindow_method) (Lisp_Image_Instance *); - void (*map_subwindow_method) (Lisp_Image_Instance *, int x, int y, + void (*unmap_subcontrol_method) (Lisp_Image_Instance *); + void (*map_subcontrol_method) (Lisp_Image_Instance *, int x, int y, struct display_glyph_area* dga); - void (*resize_subwindow_method) (Lisp_Image_Instance *, int w, int h); void (*redisplay_subwindow_method) (Lisp_Image_Instance *); void (*redisplay_widget_method) (Lisp_Image_Instance *); /* Maybe this should be a specifier. Unfortunately specifiers don't ＠＠ -310,6 +363,35 ＠＠ Lisp_Object type, Lisp_Object keys); #endif + +#ifdef HAVE_XLIKE + /* Underlying methods to implement differences between X and GTK. + Similarities are abstracted out into redisplay-xlike.c. */ + int (*text_width_single_run_method) (struct face_cachel *cachel, + struct textual_run *run); + /* Given a number of parameters return a GC with those properties. */ + void * (*get_gc_method) (struct device *d, Lisp_Object font, + Lisp_Object fg, Lisp_Object bg, + Lisp_Object bg_pmap, Lisp_Object lwidth); + void (*set_clip_rectangle_method) (struct frame *f, void *gc, int x, int y, + int width, int height); + void (*unset_clip_rectangle_method) (struct frame *f, void *gc); + void (*draw_rectangle_method) (struct frame *f, void *gc, int filled, + int x, int y, int width, int height); + void (*draw_hline_method) (struct frame *f, int x1, int x2, int y, + int thickness); + void (*draw_line_method) (struct frame *f, void *gc, int x1, int y1, + int x2, int y2); + int (*get_font_property_method) (Lisp_Object font, + enum xlike_font_property prop, + int *value); + void (*draw_text_method) (struct frame *f, Lisp_Object font, void *gc, + int bgc_present, int x, int y, unsigned char *ptr, + int len, int dimension); + void (*clear_area_method) (struct frame *f, int x, int y, int width, + int height); + void (*set_spot_location_method) (struct frame *f, int x, int y); +#endif }; #define CONMETH_TYPE(meths) ((meths)->symbol) ＠＠ -374,24 +456,33 ＠＠ #define DEFINE_CONSOLE_TYPE(type) \ struct console_methods * type##_console_methods + +/* Initialize a console type used only so that other types can share its + methods, and not visible to the Lisp code */ -#define INITIALIZE_CONSOLE_TYPE(type, obj_name, pred_sym) do { \ - type##_console_methods = xnew_and_zero (struct console_methods); \ - type##_console_methods->name = obj_name; \ - type##_console_methods->symbol = Q##type; \ - defsymbol_nodump (&type##_console_methods->predicate_symbol, pred_sym); \ - add_entry_to_console_type_list (Q##type, type##_console_methods); \ - type##_console_methods->image_conversion_list = Qnil; \ - staticpro_nodump (&type##_console_methods->image_conversion_list); \ - dump_add_root_block_ptr (&type##_console_methods, &console_methods_description); \ +#define INITIALIZE_PSEUDO_CONSOLE_TYPE(type) do { \ + type##_console_methods = xnew_and_zero (struct console_methods); \ + type##_console_methods->name = #type; \ + type##_console_methods->symbol = Q##type; \ + defsymbol_nodump (&type##_console_methods->predicate_symbol, \ + "console-" #type "-p"); \ + type##_console_methods->image_conversion_list = Qnil; \ + staticpro_nodump (&type##_console_methods->image_conversion_list); \ + dump_add_root_block_ptr (&type##_console_methods, \ + &console_methods_description); \ } while (0) -#define REINITIALIZE_CONSOLE_TYPE(type) do { \ - staticpro_nodump (&type##_console_methods->predicate_symbol); \ - staticpro_nodump (&type##_console_methods->image_conversion_list); \ +#define INITIALIZE_CONSOLE_TYPE(type) do { \ + INITIALIZE_PSEUDO_CONSOLE_TYPE (type); \ + add_entry_to_console_type_list (Q##type, type##_console_methods); \ } while (0) +#define REINITIALIZE_CONSOLE_TYPE(type) do { \ + staticpro_nodump (&type##_console_methods->predicate_symbol); \ + staticpro_nodump (&type##_console_methods->image_conversion_list); \ +} while (0) + /* Declare that console-type TYPE has method M; used in initialization routines */ #define CONSOLE_HAS_METHOD(type, m) \ ＠＠ -400,7 +491,7 ＠＠ /* Declare that console-type TYPE inherits method M implementation from console-type FROMTYPE */ #define CONSOLE_INHERITS_METHOD(type, fromtype, m) \ - (type##_console_methods->m##_method = fromtype##_##m) + (type##_console_methods->m##_method = fromtype##_console_methods->m##_method) /* Define console type implementation flags */ #define CONSOLE_IMPLEMENTATION_FLAGS(type, flg) \ ＠＠ -517,7 +608,8 ＠＠ #define CONSOLE_TYPESYM_STREAM_P(typesym) EQ (typesym, Qstream) #define CONSOLE_TYPESYM_WIN_P(typesym) \ - (CONSOLE_TYPESYM_GTK_P (typesym) || CONSOLE_TYPESYM_X_P (typesym) || CONSOLE_TYPESYM_MSWINDOWS_P (typesym)) + (CONSOLE_TYPESYM_GTK_P (typesym) || CONSOLE_TYPESYM_X_P (typesym) || \ + CONSOLE_TYPESYM_MSWINDOWS_P (typesym)) #define CONSOLE_X_P(con) CONSOLE_TYPESYM_X_P (CONSOLE_TYPE (con)) #define CHECK_X_CONSOLE(z) CHECK_CONSOLE_TYPE (z, x) ＠＠ -531,7 +623,8 ＠＠ #define CHECK_TTY_CONSOLE(z) CHECK_CONSOLE_TYPE (z, tty) #define CONCHECK_TTY_CONSOLE(z) CONCHECK_CONSOLE_TYPE (z, tty) -#define CONSOLE_MSWINDOWS_P(con) CONSOLE_TYPESYM_MSWINDOWS_P (CONSOLE_TYPE (con)) +#define CONSOLE_MSWINDOWS_P(con) \ + CONSOLE_TYPESYM_MSWINDOWS_P (CONSOLE_TYPE (con)) #define CHECK_MSWINDOWS_CONSOLE(z) CHECK_CONSOLE_TYPE (z, mswindows) #define CONCHECK_MSWINDOWS_CONSOLE(z) CONCHECK_CONSOLE_TYPE (z, mswindows) ＠＠ -563,7 +656,8 ＠＠ #define CONSOLE_SELECTED_DEVICE(con) ((con)->selected_device) #define CONSOLE_SELECTED_FRAME(con) \ DEVICE_SELECTED_FRAME (XDEVICE ((con)->selected_device)) -#define CONSOLE_LAST_NONMINIBUF_FRAME(con) NON_LVALUE ((con)->last_nonminibuf_frame) +#define CONSOLE_LAST_NONMINIBUF_FRAME(con) \ + NON_LVALUE ((con)->last_nonminibuf_frame) #define CONSOLE_QUIT_CHAR(con) ((con)->quit_char) #define CONSOLE_QUIT_EVENT(con) ((con)->quit_event) #define CONSOLE_CRITICAL_QUIT_EVENT(con) ((con)->critical_quit_event) 1.3.6.1 +3 -1 XEmacs/xemacs/src/console-msw-impl.h Index: console-msw-impl.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/console-msw-impl.h,v retrieving revision 1.3 retrieving revision 1.3.6.1 diff -u -r1.3 -r1.3.6.1 --- console-msw-impl.h 2003/01/12 11:08:09 1.3 +++ console-msw-impl.h 2005/02/16 00:42:47 1.3.6.1 ＠＠ -277,8 +277,10 ＠＠ { struct lcrecord_header header; + /* Owning frame */ Lisp_Object frame; - Lisp_Object callbacks; + /* Vector of gui-item structures, each describing one of the buttons */ + Lisp_Object gui_items; HWND hwnd; }; 1.18.6.1 +2 -2 XEmacs/xemacs/src/console-msw.c Index: console-msw.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/console-msw.c,v retrieving revision 1.18 retrieving revision 1.18.6.1 diff -u -r1.18 -r1.18.6.1 --- console-msw.c 2004/11/04 23:06:18 1.18 +++ console-msw.c 2005/02/16 00:42:47 1.18.6.1 ＠＠ -673,7 +673,7 ＠＠ void console_type_create_mswindows (void) { - INITIALIZE_CONSOLE_TYPE (mswindows, "mswindows", "console-mswindows-p"); + INITIALIZE_CONSOLE_TYPE (mswindows); /* console methods */ /* CONSOLE_HAS_METHOD (mswindows, init_console); */ ＠＠ -685,7 +685,7 ＠＠ /* CONSOLE_HAS_METHOD (mswindows, semi_canonicalize_console_connection); */ /* CONSOLE_HAS_METHOD (mswindows, semi_canonicalize_device_connection); */ - INITIALIZE_CONSOLE_TYPE (msprinter, "msprinter", "console-msprinter-p"); + INITIALIZE_CONSOLE_TYPE (msprinter); CONSOLE_HAS_METHOD (msprinter, canonicalize_console_connection); CONSOLE_HAS_METHOD (msprinter, canonicalize_device_connection); } 1.46.6.1 +11 -5 XEmacs/xemacs/src/console-msw.h Index: console-msw.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/console-msw.h,v retrieving revision 1.46 retrieving revision 1.46.6.1 diff -u -r1.46 -r1.46.6.1 --- console-msw.h 2004/11/04 23:06:18 1.46 +++ console-msw.h 2005/02/16 00:42:47 1.46.6.1 ＠＠ -84,6 +84,17 ＠＠ int height; } XEMACS_RECT_WH; +/* + * Events + */ + +/* win32 messages / magic event types */ +#define EVENT_MSWINDOWS_MAGIC_TYPE(e) \ + ((e)->event.magic.underlying_mswindows_event) +#define XM_BUMPQUEUE (WM_USER + 101) +#define XM_MAPFRAME (WM_USER + 102) +#define XM_UNMAPFRAME (WM_USER + 103) + ANSI_ALIASING_TYPEDEF (POINTS, POINTS); #define XE_MAKEPOINTS(l) ANSI_ALIASING_CAST (POINTS, l) ＠＠ -121,11 +132,6 ＠＠ HDDEDATA hdata, DWORD dwData1, DWORD dwData2); -void mswindows_enqueue_dispatch_event (Lisp_Object event); -void mswindows_enqueue_misc_user_event (Lisp_Object channel, - Lisp_Object function, - Lisp_Object object); -Lisp_Object mswindows_cancel_dispatch_event (Lisp_Event *event); Lisp_Object mswindows_pump_outstanding_events (void); void mswindows_unmodalize_signal_maybe (void); 1.25.4.1 +1 -1 XEmacs/xemacs/src/console-stream.c Index: console-stream.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/console-stream.c,v retrieving revision 1.25 retrieving revision 1.25.4.1 diff -u -r1.25 -r1.25.4.1 --- console-stream.c 2005/01/24 23:33:48 1.25 +++ console-stream.c 2005/02/16 00:42:48 1.25.4.1 ＠＠ -300,7 +300,7 ＠＠ void console_type_create_stream (void) { - INITIALIZE_CONSOLE_TYPE (stream, "stream", "console-stream-p"); + INITIALIZE_CONSOLE_TYPE (stream); /* console methods */ CONSOLE_HAS_METHOD (stream, init_console); 1.31.6.1 +1 -1 XEmacs/xemacs/src/console-tty.c Index: console-tty.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/console-tty.c,v retrieving revision 1.31 retrieving revision 1.31.6.1 diff -u -r1.31 -r1.31.6.1 --- console-tty.c 2004/09/20 19:19:36 1.31 +++ console-tty.c 2005/02/16 00:42:48 1.31.6.1 ＠＠ -366,7 +366,7 ＠＠ void console_type_create_tty (void) { - INITIALIZE_CONSOLE_TYPE (tty, "tty", "console-tty-p"); + INITIALIZE_CONSOLE_TYPE (tty); /* console methods */ CONSOLE_HAS_METHOD (tty, init_console); 1.3.6.1 +2 -1 XEmacs/xemacs/src/console-x-impl.h Index: console-x-impl.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/console-x-impl.h,v retrieving revision 1.3 retrieving revision 1.3.6.1 diff -u -r1.3 -r1.3.6.1 --- console-x-impl.h 2004/11/04 23:06:18 1.3 +++ console-x-impl.h 2005/02/16 00:42:48 1.3.6.1 ＠＠ -1,7 +1,7 ＠＠ /* Define X specific console, device, and frame object for XEmacs. Copyright (C) 1989, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. - Copyright (C) 1996, 2002, 2003 Ben Wing. + Copyright (C) 1996, 2002, 2003, 2005 Ben Wing. This file is part of XEmacs. ＠＠ -39,6 +39,7 ＠＠ #include "console-x.h" DECLARE_CONSOLE_TYPE (x); +DECLARE_CONSOLE_TYPE (xlike); struct x_device { 1.13.6.1 +2 -3 XEmacs/xemacs/src/console-x.c Index: console-x.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/console-x.c,v retrieving revision 1.13 retrieving revision 1.13.6.1 diff -u -r1.13 -r1.13.6.1 --- console-x.c 2004/09/20 19:19:36 1.13 +++ console-x.c 2005/02/16 00:42:49 1.13.6.1 ＠＠ -194,7 +194,7 ＠＠ connection = x_device_to_console_connection (connection, errb); /* Check for a couple of standard special cases */ - if (string_ichar (connection, 0) == ':') + if (string_ichar_at (connection, 0) == ':') connection = concat2 (build_string ("localhost"), connection); else { ＠＠ -299,7 +299,7 ＠＠ void console_type_create_x (void) { - INITIALIZE_CONSOLE_TYPE (x, "x", "console-x-p"); + INITIALIZE_CONSOLE_TYPE (x); CONSOLE_HAS_METHOD (x, semi_canonicalize_console_connection); CONSOLE_HAS_METHOD (x, canonicalize_console_connection); ＠＠ -308,7 +308,6 ＠＠ CONSOLE_HAS_METHOD (x, device_to_console_connection); CONSOLE_HAS_METHOD (x, initially_selected_for_input); } - void reinit_console_type_create_x (void) 1.21.4.1 +0 -20 XEmacs/xemacs/src/console-x.h Index: console-x.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/console-x.h,v retrieving revision 1.21 retrieving revision 1.21.4.1 diff -u -r1.21 -r1.21.4.1 --- console-x.h 2005/01/17 10:10:18 1.21 +++ console-x.h 2005/02/16 00:42:49 1.21.4.1 ＠＠ -135,26 +135,6 ＠＠ Extbyte *menu_separator_style_and_to_external (const Ibyte *s); Lisp_Object widget_value_unwind (Lisp_Object closure); -void x_output_string (struct window *w, struct display_line *dl, - Ichar_dynarr *buf, int xpos, int xoffset, - int start_pixpos, int width, face_index findex, - int cursor, int cursor_start, int cursor_width, - int cursor_height); -void x_output_x_pixmap (struct frame *f, Lisp_Image_Instance *p, - int x, int y, int xoffset, int yoffset, - int width, int height, - unsigned long fg, unsigned long bg, - GC override_gc); -void x_output_shadows (struct frame *f, int x, int y, int width, - int height, GC top_shadow_gc, - GC bottom_shadow_gc, GC background_gc, - int shadow_thickness, int edges); -void x_generate_shadow_pixels (struct frame *f, - unsigned long *top_shadow, - unsigned long *bottom_shadow, - unsigned long background, - unsigned long core_background); - int x_initialize_frame_menubar (struct frame *f); void x_init_modifier_mapping (struct device *d); 1.40.4.1 +9 -2 XEmacs/xemacs/src/console.c Index: console.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/console.c,v retrieving revision 1.40 retrieving revision 1.40.4.1 diff -u -r1.40 -r1.40.4.1 --- console.c 2005/02/03 16:14:04 1.40 +++ console.c 2005/02/16 00:42:50 1.40.4.1 ＠＠ -293,7 +293,14 ＠＠ */ (object)) { - return CDFW_CONSOLE (object); + return (WINDOWP (object) && WINDOW_LIVE_P (XWINDOW (object)) ? + WINDOW_CONSOLE (XWINDOW (object)) : + FRAMEP (object) && FRAME_LIVE_P (XFRAME (object)) ? + FRAME_CONSOLE (XFRAME (object)) : + DEVICEP (object) && DEVICE_LIVE_P (XDEVICE (object)) ? + DEVICE_CONSOLE (XDEVICE (object)) : + CONSOLEP (object) && CONSOLE_LIVE_P (XCONSOLE (object)) + ? object : Qnil); } int ＠＠ -1270,7 +1277,7 ＠＠ staticpro (&Vconsole_type_list); /* Initialize the dead console type */ - INITIALIZE_CONSOLE_TYPE (dead, "dead", "console-dead-p"); + INITIALIZE_CONSOLE_TYPE (dead); /* then reset the console-type lists, because `dead' is not really a valid console type */ 1.42.6.1 +12 -7 XEmacs/xemacs/src/console.h Index: console.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/console.h,v retrieving revision 1.42 retrieving revision 1.42.6.1 diff -u -r1.42 -r1.42.6.1 --- console.h 2004/03/08 15:23:02 1.42 +++ console.h 2005/02/16 00:42:50 1.42.6.1 ＠＠ -103,13 +103,6 ＠＠ x = wrong_type_argument (Qconsole_live_p, (x)); \ } while (0) -#define CDFW_CONSOLE(obj) \ - ((WINDOWP (obj) && WINDOW_LIVE_P (XWINDOW(obj))) ? WINDOW_CONSOLE (XWINDOW (obj)) \ - : ((FRAMEP (obj) && FRAME_LIVE_P (XFRAME (obj))) ? FRAME_CONSOLE (XFRAME (obj)) \ - : ((DEVICEP (obj) && DEVICE_LIVE_P (XDEVICE (obj))) ? DEVICE_CONSOLE (XDEVICE (obj)) \ - : ((CONSOLEP (obj) && CONSOLE_LIVE_P (XCONSOLE (obj))) ? obj \ - : Qnil)))) - #define CONSOLE_LOOP(concons) LIST_LOOP (concons, Vconsole_list) #define CONSOLE_DEVICE_LOOP(devcons, con) \ LIST_LOOP (devcons, CONSOLE_DEVICE_LIST (con)) ＠＠ -141,5 +134,17 ＠＠ void set_console_last_nonminibuf_frame (struct console *con, Lisp_Object frame); void stuff_buffered_input (Lisp_Object); + +#ifdef HAVE_XLIKE + +enum xlike_font_property + { + XLIKE_UNDERLINE_POSITION, + XLIKE_UNDERLINE_THICKNESS, + XLIKE_STRIKEOUT_ASCENT, + XLIKE_STRIKEOUT_DESCENT, + }; + +#endif /* HAVE_XLIKE */ #endif /* INCLUDED_console_h_ */ 1.62.4.1 +20 -2 XEmacs/xemacs/src/data.c Index: data.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/data.c,v retrieving revision 1.62 retrieving revision 1.62.4.1 diff -u -r1.62 -r1.62.4.1 --- data.c 2005/02/03 16:14:04 1.62 +++ data.c 2005/02/16 00:42:50 1.62.4.1 ＠＠ -344,7 +344,8 ＠＠ DEFUN ("subr-max-args", Fsubr_max_args, 1, 1, 0, /* Return maximum number of args built-in function SUBR may be called with, -or nil if it takes an arbitrary number of arguments or is a special form. +or nil if it takes an arbitrary number of arguments, is a special form +or allows keywords. */ (subr)) { ＠＠ -353,6 +354,8 ＠＠ nargs = XSUBR (subr)->max_args; if (nargs == MANY || nargs == UNEVALLED) return Qnil; + else if (nargs <= KEYWORD_NEGATIVE_ARG_CONVERTER) + return Qnil; else return make_int (nargs); } ＠＠ -758,7 +761,7 ＠＠ else if (STRINGP (array)) { if (idx >= string_char_length (array)) goto range_error; - return make_char (string_ichar (array, idx)); + return make_char (string_ichar_at (array, idx)); } #ifdef LOSING_BYTECODE else if (COMPILED_FUNCTIONP (array)) ＠＠ -979,6 +982,7 ＠＠ Return t if all the arguments are numerically equal. The arguments may be numbers, characters or markers. */ + /* (value &rest more-values) */ (int nargs, Lisp_Object *args)) { ARITHCOMPARE_MANY (==, eql) ＠＠ -988,6 +992,7 ＠＠ Return t if the sequence of arguments is monotonically increasing. The arguments may be numbers, characters or markers. */ + /* (value &rest more-values) */ (int nargs, Lisp_Object *args)) { ARITHCOMPARE_MANY (<, lt) ＠＠ -997,6 +1002,7 ＠＠ Return t if the sequence of arguments is monotonically decreasing. The arguments may be numbers, characters or markers. */ + /* (value &rest more-values) */ (int nargs, Lisp_Object *args)) { ARITHCOMPARE_MANY (>, gt) ＠＠ -1006,6 +1012,7 ＠＠ Return t if the sequence of arguments is monotonically nondecreasing. The arguments may be numbers, characters or markers. */ + /* (value &rest more-values) */ (int nargs, Lisp_Object *args)) { ARITHCOMPARE_MANY (<=, le) ＠＠ -1015,6 +1022,7 ＠＠ Return t if the sequence of arguments is monotonically nonincreasing. The arguments may be numbers, characters or markers. */ + /* (value &rest more-values) */ (int nargs, Lisp_Object *args)) { ARITHCOMPARE_MANY (>=, ge) ＠＠ -1030,6 +1038,7 ＠＠ Return t if no two arguments are numerically equal. The arguments may be numbers, characters or markers. */ + /* (value &rest more-values) */ (int nargs, Lisp_Object *args)) { #ifdef WITH_NUMBER_TYPES ＠＠ -1410,6 +1419,7 ＠＠ Return sum of any number of arguments. The arguments should all be numbers, characters or markers. */ + /* (&rest values) */ (int nargs, Lisp_Object *args)) { #ifdef WITH_NUMBER_TYPES ＠＠ -1482,6 +1492,7 ＠＠ With one arg, negates it. With more than one arg, subtracts all but the first from the first. */ + /* (value &rest more-values) */ (int nargs, Lisp_Object *args)) { #ifdef WITH_NUMBER_TYPES ＠＠ -1604,6 +1615,7 ＠＠ Return product of any number of arguments. The arguments should all be numbers, characters or markers. */ + /* (&rest values) */ (int nargs, Lisp_Object *args)) { #ifdef WITH_NUMBER_TYPES ＠＠ -1743,6 +1755,7 ＠＠ The arguments must be numbers, characters or markers. With one argument, reciprocates the argument. */ + /* (value &rest more-values) */ (int nargs, Lisp_Object *args)) { #ifdef WITH_NUMBER_TYPES ＠＠ -1862,6 +1875,7 ＠＠ The value is always a number; markers and characters are converted to numbers. */ + /* (value &rest more-values) */ (int nargs, Lisp_Object *args)) { #ifdef WITH_NUMBER_TYPES ＠＠ -1957,6 +1971,7 ＠＠ The value is always a number; markers and characters are converted to numbers. */ + /* (value &rest more-values) */ (int nargs, Lisp_Object *args)) { #ifdef WITH_NUMBER_TYPES ＠＠ -2050,6 +2065,7 ＠＠ Return bitwise-and of all the arguments. Arguments may be integers, or markers or characters converted to integers. */ + /* (&rest values) */ (int nargs, Lisp_Object *args)) { #ifdef HAVE_BIGNUM ＠＠ -2100,6 +2116,7 ＠＠ Return bitwise-or of all the arguments. Arguments may be integers, or markers or characters converted to integers. */ + /* (&rest values) */ (int nargs, Lisp_Object *args)) { #ifdef HAVE_BIGNUM ＠＠ -2150,6 +2167,7 ＠＠ Return bitwise-exclusive-or of all the arguments. Arguments may be integers, or markers or characters converted to integers. */ + /* (&rest values) */ (int nargs, Lisp_Object *args)) { #ifdef HAVE_BIGNUM 1.14.6.1 +1 -1 XEmacs/xemacs/src/device-gtk.c Index: device-gtk.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/device-gtk.c,v retrieving revision 1.14 retrieving revision 1.14.6.1 diff -u -r1.14 -r1.14.6.1 --- device-gtk.c 2004/09/20 19:19:37 1.14 +++ device-gtk.c 2005/02/16 00:42:51 1.14.6.1 ＠＠ -541,7 +541,7 ＠＠ if (!NILP (cursor)) { CHECK_POINTER_GLYPH (cursor); - cursor = glyph_image_instance (cursor, device, ERROR_ME, 0); + cursor = glyph_image_instance (cursor, device, Qunbound, ERROR_ME, 0); } /* We should call gdk_pointer_grab() and (possibly) gdk_keyboard_grab() here instead */ 1.4.6.1 +6 -6 XEmacs/xemacs/src/device-impl.h Index: device-impl.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/device-impl.h,v retrieving revision 1.4 retrieving revision 1.4.6.1 diff -u -r1.4 -r1.4.6.1 --- device-impl.h 2003/01/12 11:08:11 1.4 +++ device-impl.h 2005/02/16 00:42:51 1.4.6.1 ＠＠ -94,8 +94,8 ＠＠ unsigned int frame_layout_changed :1; /* The layout of frame elements has changed. */ unsigned int glyphs_changed :1; - unsigned int subwindows_changed :1; - unsigned int subwindows_state_changed :1; + unsigned int subcontrols_changed :1; + unsigned int subcontrols_state_changed :1; unsigned int icon_changed :1; unsigned int menubar_changed :1; unsigned int modeline_changed :1; ＠＠ -293,11 +293,11 ＠＠ #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_SUBCONTROLS_CHANGED(d) \ + ((void) (subcontrols_changed = (d)->subcontrols_changed = 1)) -#define MARK_DEVICE_SUBWINDOWS_STATE_CHANGED(d) \ - ((void) (subwindows_state_changed = (d)->subwindows_state_changed = 1)) +#define MARK_DEVICE_SUBCONTROLS_STATE_CHANGED(d) \ + ((void) (subcontrols_state_changed = (d)->subcontrols_state_changed = 1)) #define MARK_DEVICE_TOOLBARS_CHANGED(d) \ ((void) (toolbar_changed = (d)->toolbar_changed = 1)) 1.61.4.1 +1 -1 XEmacs/xemacs/src/device-x.c Index: device-x.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/device-x.c,v retrieving revision 1.61 retrieving revision 1.61.4.1 diff -u -r1.61 -r1.61.4.1 --- device-x.c 2005/02/03 16:30:35 1.61 +++ device-x.c 2005/02/16 00:42:52 1.61.4.1 ＠＠ -1838,7 +1838,7 ＠＠ if (!NILP (cursor)) { CHECK_POINTER_GLYPH (cursor); - cursor = glyph_image_instance (cursor, device, ERROR_ME, 0); + cursor = glyph_image_instance (cursor, device, Qunbound, ERROR_ME, 0); } if (!NILP (ignore_keyboard)) 1.33.4.1 +6 -11 XEmacs/xemacs/src/device.c Index: device.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/device.c,v retrieving revision 1.33 retrieving revision 1.33.4.1 diff -u -r1.33 -r1.33.4.1 --- device.c 2005/02/03 16:14:04 1.33 +++ device.c 2005/02/16 00:42:52 1.33.4.1 ＠＠ -37,6 +37,7 ＠＠ #include "events.h" #include "faces.h" #include "frame-impl.h" +#include "glyphs.h" #include "keymap.h" #include "objects.h" #include "redisplay.h" ＠＠ -210,19 +211,13 ＠＠ /* #### is 20 reasonable? */ d->color_instance_cache = - make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQUAL); + make_lisp_hash_table (20, hash_table_key_weak, HASH_TABLE_EQUAL); d->font_instance_cache = - make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQUAL); + make_lisp_hash_table (20, hash_table_key_weak, HASH_TABLE_EQUAL); #ifdef MULE initialize_charset_font_caches (d); #endif - /* - Note that the image instance cache is actually bi-level. - See device.h. We use a low number here because most of the - time there aren't very many different masks that will be used. - */ - d->image_instance_cache = - make_lisp_hash_table (5, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + d->image_instance_cache = make_image_instance_device_cache (); UNGCPRO; return d; ＠＠ -849,7 +844,7 ＠＠ if (FRAME_LIVE_P (f)) { - Lisp_Object popup = Fframe_property (XCAR (frmcons), Qpopup, Qnil); + Lisp_Object popup = Fget (XCAR (frmcons), Qpopup, Qnil); if (!NILP (popup)) delete_frame_internal (f, 1, 1, from_io_error); ＠＠ -1005,7 +1000,7 ＠＠ recompute_all_cached_specifiers_in_frame (f); MARK_FRAME_FACES_CHANGED (f); MARK_FRAME_GLYPHS_CHANGED (f); - MARK_FRAME_SUBWINDOWS_CHANGED (f); + MARK_FRAME_SUBCONTROLS_CHANGED (f); MARK_FRAME_TOOLBARS_CHANGED (f); MARK_FRAME_GUTTERS_CHANGED (f); f->menubar_changed = 1; 1.3.6.1 +2 -4 XEmacs/xemacs/src/devslots.h Index: devslots.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/devslots.h,v retrieving revision 1.3 retrieving revision 1.3.6.1 diff -u -r1.3 -r1.3.6.1 --- devslots.h 2003/01/12 11:08:11 1.3 +++ devslots.h 2005/02/16 00:42:52 1.3.6.1 ＠＠ -110,10 +110,8 ＠＠ MARKED_SLOT (charset_font_cache_stage_2) #endif - /* This is a bi-level cache, where the hash table in this slot here - indexes image-instance-type masks (there are currently 6 - image-instance types and thus 64 possible masks) to key-weak hash - tables like the one for colors. */ + /* This maps image specifiers/instantiator formats into image instances + or (for failures) instantiators. See comment at top of glyphs.c. */ MARKED_SLOT (image_instance_cache) #undef MARKED_SLOT 1.32.4.1 +17 -16 XEmacs/xemacs/src/dialog-msw.c Index: dialog-msw.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/dialog-msw.c,v retrieving revision 1.32 retrieving revision 1.32.4.1 diff -u -r1.32 -r1.32.4.1 --- dialog-msw.c 2004/12/06 03:52:03 1.32 +++ dialog-msw.c 2005/02/16 00:42:53 1.32.4.1 ＠＠ -32,6 +32,7 ＠＠ #include "lisp.h" #include "buffer.h" +#include "events.h" #include "frame-impl.h" #include "gui.h" #include "opaque.h" ＠＠ -171,7 +172,7 ＠＠ static const struct memory_description mswindows_dialog_id_description [] = { { XD_LISP_OBJECT, offsetof (struct mswindows_dialog_id, frame) }, - { XD_LISP_OBJECT, offsetof (struct mswindows_dialog_id, callbacks) }, + { XD_LISP_OBJECT, offsetof (struct mswindows_dialog_id, gui_items) }, { XD_END } }; ＠＠ -180,7 +181,7 ＠＠ { struct mswindows_dialog_id *data = XMSWINDOWS_DIALOG_ID (obj); mark_object (data->frame); - return data->callbacks; + return data->gui_items; } DEFINE_LRECORD_IMPLEMENTATION ("mswindows-dialog-id", mswindows_dialog_id, ＠＠ -210,25 +211,26 ＠＠ case WM_COMMAND: { - Lisp_Object fn, arg, data; + Lisp_Object data; struct mswindows_dialog_id *did; data = VOID_TO_LISP ((void *) qxeGetWindowLong (hwnd, DWL_USER)); did = XMSWINDOWS_DIALOG_ID (data); if (w_param != IDCANCEL) /* user pressed escape */ { + Lisp_Object gui_item; + assert (w_param >= ID_ITEM_BIAS && (EMACS_INT) w_param - < XVECTOR_LENGTH (did->callbacks) + ID_ITEM_BIAS); - - get_gui_callback (XVECTOR_DATA (did->callbacks) - [w_param - ID_ITEM_BIAS], - &fn, &arg); - mswindows_enqueue_misc_user_event (did->frame, fn, arg); + < XVECTOR_LENGTH (did->gui_items) + ID_ITEM_BIAS); + + gui_item = XVECTOR_DATA (did->gui_items) [w_param - ID_ITEM_BIAS]; + enqueue_activate_event (ACTIVATE_DIALOG_BOX_SELECTION, did->frame, + XGUI_ITEM (gui_item)->name, + XGUI_ITEM (gui_item)->callback); } else - mswindows_enqueue_misc_user_event (did->frame, Qrun_hooks, - Qmenu_no_selection_hook); + enqueue_notify_event (NOTIFY_DIALOG_BOX_CANCELLED, did->frame); va_run_hook_with_args_trapping_problems (Qdialog, Qdelete_dialog_box_hook, 1, data, 0); ＠＠ -743,8 +745,8 ＠＠ } /* Now the Windows dialog structure is ready. We need to prepare a - data structure for the new dialog, which will contain callbacks - and the frame for these callbacks. This structure has to be + data structure for the new dialog, which will contain gui items + and the frame for these gui items. This structure has to be GC-protected and thus it is put into a statically protected list. */ { ＠＠ -757,10 +759,9 ＠＠ dialog_data = wrap_mswindows_dialog_id (did); did->frame = wrap_frame (f); - did->callbacks = make_vector (Dynarr_length (dialog_items), Qunbound); + did->gui_items = make_vector (Dynarr_length (dialog_items), Qunbound); for (i = 0; i < Dynarr_length (dialog_items); i++) - XVECTOR_DATA (did->callbacks) [i] = - XGUI_ITEM (*Dynarr_atp (dialog_items, i))->callback; + XVECTOR_DATA (did->gui_items) [i] = Dynarr_at (dialog_items, i); /* Woof! Everything is ready. Pop pop pop in now! */ did->hwnd = 1.15.6.1 +19 -59 XEmacs/xemacs/src/dialog-x.c Index: dialog-x.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/dialog-x.c,v retrieving revision 1.15 retrieving revision 1.15.6.1 diff -u -r1.15 -r1.15.6.1 --- dialog-x.c 2004/09/20 19:19:38 1.15 +++ dialog-x.c 2005/02/16 00:42:53 1.15.6.1 ＠＠ -40,37 +40,6 ＠＠ #include "EmacsFrame.h" static void -maybe_run_dbox_text_callback (LWLIB_ID id) -{ - widget_value *wv; - int got_some; - wv = xmalloc_widget_value (); - wv->name = xstrdup ("value"); - got_some = lw_get_some_values (id, wv); - if (got_some) - { - Lisp_Object text_field_callback; - Extbyte *text_field_value = wv->value; - text_field_callback = VOID_TO_LISP (wv->call_data); - text_field_callback = XCAR (XCDR (text_field_callback)); - if (text_field_value) - { - void *tmp = - LISP_TO_VOID (cons3 (Qnil, - list2 (text_field_callback, - build_ext_string (text_field_value, - Qlwlib_encoding)), - Qnil)); - popup_selection_callback (0, id, (XtPointer) tmp); - } - } - /* This code tried to optimize, newing/freeing. This is generally - unsafe so we will always strdup and always use - free_widget_value_tree. */ - free_widget_value_tree (wv); -} - -static void dbox_selection_callback (Widget widget, LWLIB_ID id, XtPointer client_data) { /* This is called with client_data == -1 when WM_DELETE_WINDOW is sent ＠＠ -92,7 +61,6 ＠＠ assert (popup_up_p != 0); ungcpro_popup_callbacks (id); popup_up_p--; - maybe_run_dbox_text_callback (id); popup_selection_callback (widget, id, client_data); /* #### need to error-protect! will do so when i merge in my working ws */ ＠＠ -121,8 +89,6 ＠＠ /* This function can GC */ int lbuttons = 0, rbuttons = 0; int partition_seen = 0; - int text_field_p = 0; - int allow_text_p = 1; widget_value *prev = 0, *kids = 0; int n = 0; int count; ＠＠ -174,6 +140,10 ＠＠ LISP_STRING_TO_EXTERNAL_MALLOC (question, prev->value, Qlwlib_encoding); prev->enabled = 1; + /* NOTE: For a long time, this code supported an undocumented text-entry + field along with the buttons. I removed this because it was + undocumented and not supported in the Windows code, and really a hack + -- just use the more general widget support. --ben */ { EXTERNAL_LIST_LOOP_2 (button, buttons) { ＠＠ -192,36 +162,27 ＠＠ gui_item = gui_parse_item_keywords (button); if (!button_item_to_widget_value (Qdialog, - gui_item, wv, allow_text_p, 1, 0, 1)) + gui_item, wv, 0, 1, 0, 1)) { free_widget_value_tree (wv); continue; } - if (wv->type == TEXT_TYPE) - { - text_field_p = 1; - allow_text_p = 0; /* only allow one */ - } - else /* it's a button */ - { - allow_text_p = 0; /* only allow text field at the front */ - if (wv->value) - xfree (wv->value, char *); - wv->value = wv->name; /* what a mess... */ - wv->name = xstrdup (button_names [n]); + if (wv->value) + xfree (wv->value, char *); + wv->value = wv->name; /* what a mess... */ + wv->name = xstrdup (button_names [n]); - if (partition_seen) - rbuttons++; - else - lbuttons++; - n++; - - if (lbuttons > 9 || rbuttons > 9) - sferror ("Too many buttons (9)", - keys); /* #### this leaks */ - } + if (partition_seen) + rbuttons++; + else + lbuttons++; + n++; + if (lbuttons > 9 || rbuttons > 9) + sferror ("Too many buttons (9)", + keys); /* #### this leaks */ + prev->next = wv; prev = wv; } ＠＠ -231,11 +192,10 ＠＠ sferror ("Dialog boxes must have some buttons", keys); { - Extbyte type = (text_field_p ? 'P' : 'Q'); static Extbyte tmp_dbox_name [255]; widget_value *dbox; - sprintf (tmp_dbox_name, "%c%dBR%d", type, lbuttons + rbuttons, rbuttons); + sprintf (tmp_dbox_name, "Q%dBR%d", lbuttons + rbuttons, rbuttons); dbox = xmalloc_widget_value (); dbox->name = xstrdup (tmp_dbox_name); dbox->contents = kids; 1.38.6.1 +1 -1 XEmacs/xemacs/src/dired.c Index: dired.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/dired.c,v retrieving revision 1.38 retrieving revision 1.38.6.1 diff -u -r1.38 -r1.38.6.1 --- dired.c 2004/11/04 23:06:21 1.38 +++ dired.c 2005/02/16 00:42:53 1.38.6.1 ＠＠ -782,7 +782,7 ＠＠ { DIRENTRY *dp; Lisp_Object hash = - make_lisp_hash_table (20, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); + make_lisp_hash_table (20, hash_table_non_weak, HASH_TABLE_EQUAL); while ((dp = qxe_readdir (d))) { 1.8.6.1 +1 -1 XEmacs/xemacs/src/dragdrop.c Index: dragdrop.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/dragdrop.c,v retrieving revision 1.8 retrieving revision 1.8.6.1 diff -u -r1.8 -r1.8.6.1 --- dragdrop.c 2004/11/04 23:06:21 1.8 +++ dragdrop.c 2005/02/16 00:42:54 1.8.6.1 ＠＠ -28,7 +28,7 ＠＠ Currently only drops from OffiX are implemented. - A drop generates a extended misc-user-event, as defined in events.[ch]. + A drop generates a drop-event, as defined in events.[ch]. This event contains the same as a eval and a button event. The function of a drop is set to 'dragdrop-drop-dispatch' which will be defined in ../lisp/dragdrop.el. 1.51.4.1 +24 -16 XEmacs/xemacs/src/editfns.c Index: editfns.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/editfns.c,v retrieving revision 1.51 retrieving revision 1.51.4.1 diff -u -r1.51 -r1.51.4.1 --- editfns.c 2004/12/06 03:52:03 1.51 +++ editfns.c 2005/02/16 00:42:54 1.51.4.1 ＠＠ -132,7 +132,7 ＠＠ CHECK_STRING (string); if (XSTRING_LENGTH (string) != 0) - return make_char (string_ichar (string, 0)); + return make_char (string_ichar_at (string, 0)); else /* This used to return Qzero. That is broken, broken, broken. */ /* It might be kinder to signal an error directly. -slb */ ＠＠ -371,6 +371,7 ＠＠ The values of point, mark and the current buffer are restored even in case of abnormal exit (throw or error). */ + /* (&rest body) */ (args)) { /* This function can GC */ ＠＠ -396,6 +397,7 ＠＠ Save the current buffer; execute BODY; restore the current buffer. Executes BODY just like `progn'. */ + /* (&rest body) */ (args)) { /* This function can GC */ ＠＠ -475,7 +477,7 ＠＠ if (BUF_PT (b) >= BUF_ZV (b)) return Qzero; /* #### Gag me! */ else - return make_char (BUF_FETCH_CHAR (b, BUF_PT (b))); + return make_char (BUF_ICHAR_AT (b, BUF_PT (b))); } DEFUN ("preceding-char", Fpreceding_char, 0, 1, 0, /* ＠＠ -489,7 +491,7 ＠＠ if (BUF_PT (b) <= BUF_BEGV (b)) return Qzero; /* #### Gag me! */ else - return make_char (BUF_FETCH_CHAR (b, BUF_PT (b) - 1)); + return make_char (BUF_ICHAR_AT (b, BUF_PT (b) - 1)); } DEFUN ("bobp", Fbobp, 0, 1, 0, /* ＠＠ -517,7 +519,7 ＠＠ int beginning_of_line_p (struct buffer *b, Charbpos pt) { - return pt <= BUF_BEGV (b) || BUF_FETCH_CHAR (b, pt - 1) == '\n'; + return pt <= BUF_BEGV (b) || BUF_ICHAR_AT (b, pt - 1) == '\n'; } ＠＠ -539,7 +541,7 ＠＠ (buffer)) { struct buffer *b = decode_buffer (buffer, 1); - return (BUF_PT (b) == BUF_ZV (b) || BUF_FETCH_CHAR (b, BUF_PT (b)) == '\n') + return (BUF_PT (b) == BUF_ZV (b) || BUF_ICHAR_AT (b, BUF_PT (b)) == '\n') ? Qt : Qnil; } ＠＠ -558,7 +560,7 ＠＠ if (n < 0 || n == BUF_ZV (b)) return Qnil; - return make_char (BUF_FETCH_CHAR (b, n)); + return make_char (BUF_ICHAR_AT (b, n)); } DEFUN ("char-before", Fchar_before, 0, 2, 0, /* ＠＠ -578,7 +580,7 ＠＠ if (n < BUF_BEGV (b)) return Qnil; - return make_char (BUF_FETCH_CHAR (b, n)); + return make_char (BUF_ICHAR_AT (b, n)); }  ＠＠ -1150,6 +1152,8 ＠＠ Year numbers less than 100 are treated just like other year numbers. If you want them to stand for years in this century, you must do that yourself. */ + /* (second minute hour day month year &rest ignored-arguments-then-zone) + */ (int nargs, Lisp_Object *args)) { time_t the_time; ＠＠ -1472,6 +1476,7 ＠＠ Any other markers at the point of insertion remain before the text. If a string has non-null string-extent-data, new extents will be created. */ + /* (&rest strings-or-chars) */ (int nargs, Lisp_Object *args)) { /* This function can GC */ ＠＠ -1490,6 +1495,7 ＠＠ Point moves forward so that it ends up after the inserted text. Any other markers at the point of insertion also end up after the text. */ + /* (&rest strings-or-chars) */ (int nargs, Lisp_Object *args)) { /* This function can GC */ ＠＠ -1701,8 +1707,8 ＠＠ for (i = 0; i < length; i++) { - Ichar c1 = BUF_FETCH_CHAR (bp1, begp1 + i); - Ichar c2 = BUF_FETCH_CHAR (bp2, begp2 + i); + Ichar c1 = BUF_ICHAR_AT (bp1, begp1 + i); + Ichar c2 = BUF_ICHAR_AT (bp2, begp2 + i); if (!NILP (trt)) { c1 = TRT_TABLE_OF (trt, c1); ＠＠ -1779,7 +1785,7 ＠＠ mc_count = begin_multiple_change (buf, pos, stop); while (pos < stop) { - if (BUF_FETCH_CHAR (buf, pos) == fromc) + if (BUF_ICHAR_AT (buf, pos) == fromc) { /* There used to be some code here that set the buffer to unmodified if NOUNDO was specified and there was only ＠＠ -1838,14 +1844,14 ＠＠ { Charcount size = string_char_length (table); #ifdef MULE - /* Under Mule, string_ichar(n) is O(n), so for large tables or + /* Under Mule, string_ichar_at(n) is O(n), so for large tables or large regions it makes sense to create an array of Ichars. */ if (size * (stop - pos) > 65536) { Ichar *etable = alloca_array (Ichar, size); convert_ibyte_string_into_ichar_string (XSTRING_DATA (table), XSTRING_LENGTH (table), etable); - for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++) + for (; pos < stop && (oc = BUF_ICHAR_AT (buf, pos), 1); pos++) { if (oc < size) { ＠＠ -1861,11 +1867,11 ＠＠ else #endif /* MULE */ { - for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++) + for (; pos < stop && (oc = BUF_ICHAR_AT (buf, pos), 1); pos++) { if (oc < size) { - Ichar nc = string_ichar (table, oc); + Ichar nc = string_ichar_at (table, oc); if (nc != oc) { buffer_replace_char (buf, pos, nc, 0, 0); ＠＠ -1880,7 +1886,7 ＠＠ Charcount size = XVECTOR_LENGTH (table); Lisp_Object *vtable = XVECTOR_DATA (table); - for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++) + for (; pos < stop && (oc = BUF_ICHAR_AT (buf, pos), 1); pos++) { if (oc < size) { ＠＠ -1916,7 +1922,7 ＠＠ || XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR)) { - for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++) + for (; pos < stop && (oc = BUF_ICHAR_AT (buf, pos), 1); pos++) { Lisp_Object replacement = get_char_table (oc, table); retry2: ＠＠ -2130,6 +2136,7 ＠＠ use `save-excursion' outermost: (save-excursion (save-restriction ...)) */ + /* (&rest body) */ (body)) { /* This function can GC */ ＠＠ -2210,6 +2217,7 ＠＠ Use %% to put a single % into the output. */ + /* (format-string &rest args) */ (int nargs, Lisp_Object *args)) { /* It should not be necessary to GCPRO ARGS, because 1.40.4.1 +183 -155 XEmacs/xemacs/src/elhash.c Index: elhash.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/elhash.c,v retrieving revision 1.40 retrieving revision 1.40.4.1 diff -u -r1.40 -r1.40.4.1 --- elhash.c 2005/02/03 16:14:05 1.40 +++ elhash.c 2005/02/16 00:42:55 1.40.4.1 ＠＠ -1,6 +1,6 ＠＠ /* Implementation of the hash table lisp object type. Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 1995, 1996, 2002, 2004 Ben Wing. + Copyright (C) 1995, 1996, 2002, 2003, 2004, 2005 Ben Wing. Copyright (C) 1997 Free Software Foundation, Inc. This file is part of XEmacs. ＠＠ -94,12 +94,6 ＠＠ static Lisp_Object Qweak, Qkey_weak, Qvalue_weak, Qkey_or_value_weak; static Lisp_Object Qnon_weak, Q_type; -typedef struct htentry -{ - Lisp_Object key; - Lisp_Object value; -} htentry; - struct Lisp_Hash_Table { struct lcrecord_header header; ＠＠ -112,7 +106,8 ＠＠ hash_table_hash_function_t hash_function; hash_table_test_function_t test_function; htentry *hentries; - enum hash_table_weakness weakness; + int weakness_p; /* Whether WEAKNESS is 0; used for data description */ + hash_table_weak_mark_function_t weakness; Lisp_Object next_weak; /* Used to chain together all of the weak hash tables. Don't mark through this. */ }; ＠＠ -242,7 +237,7 ＠＠ /* If the hash table is weak, we don't want to mark the keys and values (we scan over them after everything else has been marked, and mark or remove them as necessary). */ - if (ht->weakness == HASH_TABLE_NON_WEAK) + if (ht->weakness == hash_table_non_weak) { htentry *e, *sentinel; ＠＠ -385,16 +380,9 ＠＠ (long) ht->size); } - if (ht->weakness != HASH_TABLE_NON_WEAK) - { - write_fmt_string - (printcharfun, " weakness %s", - (ht->weakness == HASH_TABLE_WEAK ? "key-and-value" : - ht->weakness == HASH_TABLE_KEY_WEAK ? "key" : - ht->weakness == HASH_TABLE_VALUE_WEAK ? "value" : - ht->weakness == HASH_TABLE_KEY_VALUE_WEAK ? "key-or-value" : - "you-d-better-not-see-this")); - } + if (ht->weakness != hash_table_non_weak) + write_fmt_string_lisp (printcharfun, " weakness %s", 1, + Fhash_table_weakness (wrap_hash_table (ht))); if (ht->count) print_hash_table_data (ht, printcharfun); ＠＠ -451,10 +439,19 ＠＠ static const struct memory_description htentry_union_description_1[] = { /* Note: XD_INDIRECT in this table refers to the surrounding table, and so this will work. */ +#if 1 + { XD_BLOCK_PTR, 0, XD_INDIRECT (0, 1), { &htentry_description } }, + { XD_BLOCK_PTR, 1, XD_INDIRECT (0, 1), { &htentry_description } , + XD_FLAG_NO_KKCC }, +#else + /* #### This is the previous version; I'm not positive that the above + version intentionally replaced it, or if it was accidentally carried + through from an old version of the code */ { XD_BLOCK_PTR, HASH_TABLE_NON_WEAK, XD_INDIRECT (0, 1), { &htentry_description } }, { XD_BLOCK_PTR, 0, XD_INDIRECT (0, 1), { &htentry_description }, XD_FLAG_UNION_DEFAULT_ENTRY | XD_FLAG_NO_KKCC }, +#endif { XD_END } }; ＠＠ -465,7 +462,7 ＠＠ const struct memory_description hash_table_description[] = { { XD_ELEMCOUNT, offsetof (Lisp_Hash_Table, size) }, - { XD_INT, offsetof (Lisp_Hash_Table, weakness) }, + { XD_INT, offsetof (Lisp_Hash_Table, weakness_p) }, { XD_UNION, offsetof (Lisp_Hash_Table, hentries), XD_INDIRECT (1, 0), { &htentry_union_description } }, { XD_LO_LINK, offsetof (Lisp_Hash_Table, next_weak) }, ＠＠ -510,7 +507,7 ＠＠ Elemcount size, double rehash_size, double rehash_threshold, - enum hash_table_weakness weakness) + hash_table_weak_mark_function_t weakness) { hash_table_hash_function_t hash_function = 0; hash_table_test_function_t test_function = 0; ＠＠ -541,20 +538,70 ＠＠ weakness); } +/* Most general function for creating a hash table. + + TEST_FUNCTION indicates how to compare keys, and HASH_FUNCTION how + to hash them. If two keys are equal, they *MUST* have the same hash + value -- but not necessarily vice-versa. + + SIZE is the initial size of the hash table. If the table gets to + REHASH_THRESHOLD in fullness (a factor between 0 and 1), it will be + resized by a factor of REHASH_SIZE (greater than 1). To get the defaults + for these two, specify 0 or a negative number. + + WEAK_FUNCTION controls whether this is a weak hash table -- i.e. the + keys and/or values are not necessarily marked, and may be removed during + garbage collection if there are no other references to them. It is a + function of one argument -- an htentry (equivalent to Lisp_Object_pair, + specifying a key and value) -- and it should mark the key and/or value + according to whatever criteria it wants, typically by looking at the + existing markedness. The return value, a small non-negative integer, + indicates whether anything was marked that wasn't previously marked. + + For example, to implement a "key-weak" hash table, i.e. the entry + remains when the key is referenced outside of the table: + + int + hash_table_key_weak (const htentry *e) + { + if (marked_p (e->key)) + return mark_object_if_not (e->value); + return 0; + } + + Another example -- a "key-car weak" hash table, i.e. the entry + remains when the key's car is referenced outside of the table: + + int + hash_table_key_car_weak (const htentry *e) + { + if (!CONSP (e->key) || marked_p (XCAR (e->key))) + return mark_object_if_not (e->key) + mark_object_if_not (e->value); + return 0; + } + + Note that in this case we have to mark both key and value, because the + key might not already be marked (in fact, it probably won't be). + + If either the key or value is unmarked after this function is called, + the entry will be removed. + + */ Lisp_Object make_general_lisp_hash_table (hash_table_hash_function_t hash_function, hash_table_test_function_t test_function, Elemcount size, double rehash_size, double rehash_threshold, - enum hash_table_weakness weakness) + hash_table_weak_mark_function_t weak_function) { Lisp_Object hash_table; Lisp_Hash_Table *ht = alloc_lcrecord_type (Lisp_Hash_Table, &lrecord_hash_table); ht->test_function = test_function; ht->hash_function = hash_function; - ht->weakness = weakness; + ht->weakness = weak_function; + ht->weakness_p = !!weak_function; ht->rehash_size = rehash_size > 1.0 ? rehash_size : HASH_TABLE_DEFAULT_REHASH_SIZE; ＠＠ -576,7 +623,7 ＠＠ hash_table = wrap_hash_table (ht); - if (weakness == HASH_TABLE_NON_WEAK) + if (weak_function == hash_table_non_weak) ht->next_weak = Qunbound; else ht->next_weak = Vall_weak_hash_tables, Vall_weak_hash_tables = hash_table; ＠＠ -586,7 +633,7 ＠＠ Lisp_Object make_lisp_hash_table (Elemcount size, - enum hash_table_weakness weakness, + hash_table_weak_mark_function_t weakness, enum hash_table_test test) { return make_standard_lisp_hash_table (test, size, -1.0, -1.0, weakness); ＠＠ -644,25 +691,25 ＠＠ return 0; } -static enum hash_table_weakness +static hash_table_weak_mark_function_t decode_hash_table_weakness (Lisp_Object obj) { - if (EQ (obj, Qnil)) return HASH_TABLE_NON_WEAK; - if (EQ (obj, Qt)) return HASH_TABLE_WEAK; - if (EQ (obj, Qkey_and_value)) return HASH_TABLE_WEAK; - if (EQ (obj, Qkey)) return HASH_TABLE_KEY_WEAK; - if (EQ (obj, Qkey_or_value)) return HASH_TABLE_KEY_VALUE_WEAK; - if (EQ (obj, Qvalue)) return HASH_TABLE_VALUE_WEAK; + if (EQ (obj, Qnil)) return hash_table_non_weak; + if (EQ (obj, Qt)) return hash_table_weak; + if (EQ (obj, Qkey_and_value)) return hash_table_weak; + if (EQ (obj, Qkey)) return &hash_table_key_weak; + if (EQ (obj, Qkey_or_value)) return &hash_table_key_value_weak; + if (EQ (obj, Qvalue)) return &hash_table_value_weak; /* Following values are obsolete as of 19990901 in xemacs-21.2 */ - if (EQ (obj, Qnon_weak)) return HASH_TABLE_NON_WEAK; - if (EQ (obj, Qweak)) return HASH_TABLE_WEAK; - if (EQ (obj, Qkey_weak)) return HASH_TABLE_KEY_WEAK; - if (EQ (obj, Qkey_or_value_weak)) return HASH_TABLE_KEY_VALUE_WEAK; - if (EQ (obj, Qvalue_weak)) return HASH_TABLE_VALUE_WEAK; + if (EQ (obj, Qnon_weak)) return hash_table_non_weak; + if (EQ (obj, Qweak)) return hash_table_weak; + if (EQ (obj, Qkey_weak)) return &hash_table_key_weak; + if (EQ (obj, Qkey_or_value_weak)) return &hash_table_key_value_weak; + if (EQ (obj, Qvalue_weak)) return &hash_table_value_weak; invalid_constant ("Invalid hash table weakness", obj); - RETURN_NOT_REACHED (HASH_TABLE_NON_WEAK); + RETURN_NOT_REACHED (hash_table_non_weak); } static int ＠＠ -872,7 +919,6 ＠＠ DEFUN ("make-hash-table", Fmake_hash_table, 0, MANY, 0, /* Return a new empty hash table object. Use Common Lisp style keywords to specify hash table properties. - (make-hash-table &key test size rehash-size rehash-threshold weakness) Keyword :test can be `eq', `eql' (default) or `equal'. Comparison between keys is done using this function. ＠＠ -917,6 +963,7 ＠＠ hash table if the value or key are pointed to by something other than a weak hash table, even if the other is not. */ + /* (&key test size rehash-size rehash-threshold weakness) */ (int nargs, Lisp_Object *args)) { int i = 0; ＠＠ -1238,31 +1285,38 ＠＠ */ (hash_table)) { - switch (xhash_table (hash_table)->weakness) - { - case HASH_TABLE_WEAK: return Qkey_and_value; - case HASH_TABLE_KEY_WEAK: return Qkey; - case HASH_TABLE_KEY_VALUE_WEAK: return Qkey_or_value; - case HASH_TABLE_VALUE_WEAK: return Qvalue; - default: return Qnil; - } + hash_table_weak_mark_function_t weakness = + xhash_table (hash_table)->weakness; +#define FROB(weakfun, weaksym) if (weakness == weakfun) return weaksym + FROB (hash_table_weak, Qkey_and_value); + FROB (hash_table_key_weak, Qkey); + FROB (hash_table_key_value_weak, Qkey_or_value); + FROB (hash_table_value_weak, Qvalue); + if (weakness) + return Qunknown; + return Qnil; +#undef FROB } /* obsolete as of 19990901 in xemacs-21.2 */ DEFUN ("hash-table-type", Fhash_table_type, 1, 1, 0, /* Return the type of HASH-TABLE. -This can be one of `non-weak', `weak', `key-weak' or `value-weak'. +This can be one of `non-weak', `weak', `key-weak' `key-or-value-weak', +or `value-weak'. */ (hash_table)) { - switch (xhash_table (hash_table)->weakness) - { - case HASH_TABLE_WEAK: return Qweak; - case HASH_TABLE_KEY_WEAK: return Qkey_weak; - case HASH_TABLE_KEY_VALUE_WEAK: return Qkey_or_value_weak; - case HASH_TABLE_VALUE_WEAK: return Qvalue_weak; - default: return Qnon_weak; - } + hash_table_weak_mark_function_t weakness = + xhash_table (hash_table)->weakness; +#define FROB(weakfun, weaksym) if (weakness == weakfun) return weaksym + FROB (hash_table_weak, Qweak); + FROB (hash_table_key_weak, Qkey_weak); + FROB (hash_table_key_value_weak, Qkey_or_value_weak); + FROB (hash_table_value_weak, Qvalue_weak); + if (weakness) + return Qunknown; + return Qnon_weak; +#undef FROB } /************************************************************************/ ＠＠ -1389,27 +1443,54 ＠＠ return Qnil; } -/* Map *C* function FUNCTION over the elements of a non-weak lisp hash table. +/* Map *C* function FUNCTION over the elements of a lisp hash table. FUNCTION must not modify HASH-TABLE, with the one exception that FUNCTION may puthash the entry currently being processed by FUNCTION. - Mapping terminates if FUNCTION returns something other than 0. */ -void + Mapping terminates if FUNCTION returns something other than 0, and + returns that value; otherwise, returns 0. */ +int elisp_maphash_unsafe (maphash_function_t function, - Lisp_Object hash_table, void *extra_arg) + Lisp_Object hash_table, void *extra_arg) { const Lisp_Hash_Table *ht = XHASH_TABLE (hash_table); const htentry *e, *sentinel; + int spec = 0; + int retval = 0; + /* If we are weak, GC can get in our way since it might remove entries. + So we disable it. */ + if (ht->weakness != hash_table_non_weak) + spec = begin_gc_forbidden (); for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++) if (!HTENTRY_CLEAR_P (e)) - if (function (e->key, e->value, extra_arg)) - return; + if ((retval = function (e->key, e->value, extra_arg))) + break; + if (ht->weakness != hash_table_non_weak) + end_gc_forbidden (spec); + + return retval; +} + +#if 0 + +void +elisp_map_remhash_unsafe (maphash_function_t predicate, + Lisp_Object hash_table, void *extra_arg) +{ + /* currently unimplemented; given the linear probing method, I'm 99% + sure that removing an entry will have no effect on prior entries, + so we could simply map forward from where we are. however, + copy_compress_hentries() doesn't seem to be that time-consuming so + I'm not bothering as of yet. --ben */ } +#endif + /* Map *C* function FUNCTION over the elements of a lisp hash table. It is safe for FUNCTION to modify HASH-TABLE. - Mapping terminates if FUNCTION returns something other than 0. */ -void + Mapping terminates if FUNCTION returns something other than 0, and + returns that value; otherwise, returns 0. */ +int elisp_maphash (maphash_function_t function, Lisp_Object hash_table, void *extra_arg) { ＠＠ -1418,21 +1499,25 ＠＠ const Lisp_Object *pobj, *end; int speccount = specpdl_depth (); struct gcpro gcpro1; + int retval = 0; record_unwind_protect (maphash_unwind, make_opaque_ptr ((void *)objs)); GCPRO1 (objs[0]); gcpro1.nvars = 2 * ht->count; for (pobj = objs, end = pobj + 2 * ht->count; pobj < end; pobj += 2) - if (function (pobj[0], pobj[1], extra_arg)) + if ((retval = function (pobj[0], pobj[1], extra_arg))) break; unbind_to (speccount); UNGCPRO; + + return retval; } -/* Remove all elements of a lisp hash table satisfying *C* predicate PREDICATE. - PREDICATE must not modify HASH-TABLE. */ +/* Remove all elements of a lisp hash table satisfying *C* predicate + PREDICATE. It is safe for FUNCTION to modify HASH-TABLE. + */ void elisp_map_remhash (maphash_function_t predicate, Lisp_Object hash_table, void *extra_arg) ＠＠ -1459,28 +1544,32 ＠＠ /************************************************************************/ /* garbage collecting weak hash tables */ /************************************************************************/ -#ifdef USE_KKCC -#define MARK_OBJ(obj) do { \ - Lisp_Object mo_obj = (obj); \ - if (!marked_p (mo_obj)) \ - { \ - kkcc_gc_stack_push_lisp_object (mo_obj); \ - did_mark = 1; \ - } \ -} while (0) - -#else /* NO USE_KKCC */ - -#define MARK_OBJ(obj) do { \ - Lisp_Object mo_obj = (obj); \ - if (!marked_p (mo_obj)) \ - { \ - mark_object (mo_obj); \ - did_mark = 1; \ - } \ -} while (0) -#endif /*NO USE_KKCC */ +int +hash_table_key_weak (const htentry *e) +{ + if (marked_p (e->key)) + return mark_object_if_not (e->value); + return 0; +} + +int +hash_table_value_weak (const htentry *e) +{ + if (marked_p (e->value)) + return mark_object_if_not (e->key); + return 0; +} + +int +hash_table_key_value_weak (const htentry *e) +{ + if (marked_p (e->value)) + return mark_object_if_not (e->key); + else if (marked_p (e->key)) + return mark_object_if_not (e->value); + return 0; +} /* Complete the marking for semi-weak hash tables. */ int ＠＠ -1501,76 +1590,15 ＠＠ /* The hash table is probably garbage. Ignore it. */ continue; - /* Now, scan over all the pairs. For all pairs that are - half-marked, we may need to mark the other half if we're - keeping this pair. */ - switch (ht->weakness) + assert (ht->weakness != hash_table_non_weak); + if (ht->weakness != hash_table_weak) { - case HASH_TABLE_KEY_WEAK: - for (; e < sentinel; e++) - if (!HTENTRY_CLEAR_P (e)) - if (marked_p (e->key)) - MARK_OBJ (e->value); - break; - - case HASH_TABLE_VALUE_WEAK: - for (; e < sentinel; e++) - if (!HTENTRY_CLEAR_P (e)) - if (marked_p (e->value)) - MARK_OBJ (e->key); - break; - - case HASH_TABLE_KEY_VALUE_WEAK: - for (; e < sentinel; e++) - if (!HTENTRY_CLEAR_P (e)) - { - if (marked_p (e->value)) - MARK_OBJ (e->key); - else if (marked_p (e->key)) - MARK_OBJ (e->value); - } - break; - - case HASH_TABLE_KEY_CAR_WEAK: - for (; e < sentinel; e++) - if (!HTENTRY_CLEAR_P (e)) - if (!CONSP (e->key) || marked_p (XCAR (e->key))) - { - MARK_OBJ (e->key); - MARK_OBJ (e->value); - } - break; - - /* We seem to be sprouting new weakness types at an alarming - rate. At least this is not externally visible - and in - fact all of these KEY_CAR_* types are only used by the - glyph code. */ - case HASH_TABLE_KEY_CAR_VALUE_WEAK: + /* Now, scan over all the pairs. For all pairs that are + half-marked, we may need to mark the other half if we're + keeping this pair. */ for (; e < sentinel; e++) if (!HTENTRY_CLEAR_P (e)) - { - if (!CONSP (e->key) || marked_p (XCAR (e->key))) - { - MARK_OBJ (e->key); - MARK_OBJ (e->value); - } - else if (marked_p (e->value)) - MARK_OBJ (e->key); - } - break; - - case HASH_TABLE_VALUE_CAR_WEAK: - for (; e < sentinel; e++) - if (!HTENTRY_CLEAR_P (e)) - if (!CONSP (e->value) || marked_p (XCAR (e->value))) - { - MARK_OBJ (e->key); - MARK_OBJ (e->value); - } - break; - - default: - break; + did_mark += (ht->weakness) (e); } } 1.15.4.1 +24 -20 XEmacs/xemacs/src/elhash.h Index: elhash.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/elhash.h,v retrieving revision 1.15 retrieving revision 1.15.4.1 diff -u -r1.15 -r1.15.4.1 --- elhash.h 2005/01/26 10:22:25 1.15 +++ elhash.h 2005/02/16 00:42:55 1.15.4.1 ＠＠ -1,5 +1,5 ＠＠ /* Lisp interface to hash tables -- include file. - Copyright (C) 1995, 1996 Ben Wing. + Copyright (C) 1995, 1996, 2002 Ben Wing. This file is part of XEmacs. ＠＠ -33,18 +33,6 ＠＠ #define CHECK_HASH_TABLE(x) CHECK_RECORD (x, hash_table) #define CONCHECK_HASH_TABLE(x) CONCHECK_RECORD (x, hash_table) -enum hash_table_weakness -{ - HASH_TABLE_NON_WEAK, - HASH_TABLE_KEY_WEAK, - HASH_TABLE_VALUE_WEAK, - HASH_TABLE_KEY_VALUE_WEAK, - HASH_TABLE_KEY_CAR_WEAK, - HASH_TABLE_VALUE_CAR_WEAK, - HASH_TABLE_KEY_CAR_VALUE_WEAK, - HASH_TABLE_WEAK -}; - enum hash_table_test { HASH_TABLE_EQ, ＠＠ -56,38 +44,54 ＠＠ EXFUN (Fcopy_hash_table, 1); EXFUN (Fhash_table_count, 1); +EXFUN (Fhash_table_weakness, 1); EXFUN (Fgethash, 3); EXFUN (Fputhash, 3); EXFUN (Fremhash, 2); EXFUN (Fclrhash, 1); +/* Lisp_Object_pair is the implementation of the entries in HENTRIES; we + provide a separate typedef to encapsulate the "interface", which could + conceivably change. */ +typedef Lisp_Object_pair htentry; + typedef int (*hash_table_test_function_t) (Lisp_Object obj1, Lisp_Object obj2); typedef Hashcode (*hash_table_hash_function_t) (Lisp_Object obj); +typedef int (*hash_table_weak_mark_function_t) (const htentry *e); typedef int (*maphash_function_t) (Lisp_Object key, Lisp_Object value, void* extra_arg); +int hash_table_key_weak (const htentry *e); +int hash_table_value_weak (const htentry *e); +int hash_table_key_value_weak (const htentry *e); +#define hash_table_non_weak ((hash_table_weak_mark_function_t) 0) +#define hash_table_weak ((hash_table_weak_mark_function_t) 1) + Lisp_Object make_standard_lisp_hash_table (enum hash_table_test test, Elemcount size, double rehash_size, double rehash_threshold, - enum hash_table_weakness weakness); + hash_table_weak_mark_function_t + weakness); Lisp_Object make_general_lisp_hash_table (hash_table_hash_function_t hash_function, hash_table_test_function_t test_function, Elemcount size, double rehash_size, double rehash_threshold, - enum hash_table_weakness weakness); + hash_table_weak_mark_function_t + weakness); + Lisp_Object make_lisp_hash_table (Elemcount size, - enum hash_table_weakness weakness, + hash_table_weak_mark_function_t weakness, enum hash_table_test test); -void elisp_maphash (maphash_function_t function, - Lisp_Object hash_table, void *extra_arg); +int elisp_maphash (maphash_function_t function, + Lisp_Object hash_table, void *extra_arg); -void elisp_maphash_unsafe (maphash_function_t function, - Lisp_Object hash_table, void *extra_arg); +int elisp_maphash_unsafe (maphash_function_t function, + Lisp_Object hash_table, void *extra_arg); void elisp_map_remhash (maphash_function_t predicate, Lisp_Object hash_table, void *extra_arg); 1.154.4.1 +38 -55 XEmacs/xemacs/src/emacs.c Index: emacs.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/emacs.c,v retrieving revision 1.154 retrieving revision 1.154.4.1 diff -u -r1.154 -r1.154.4.1 --- emacs.c 2005/01/31 19:29:48 1.154 +++ emacs.c 2005/02/16 00:42:55 1.154.4.1 ＠＠ -2,7 +2,7 ＠＠ Copyright (C) 1985, 1986, 1987, 1992, 1993, 1994 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 2000, 2001, 2002, 2003, 2004 Ben Wing. + Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 Ben Wing. This file is part of XEmacs. ＠＠ -1693,6 +1693,12 ＠＠ console_type_create_redisplay_tty (); #endif +#ifdef HAVE_XLIKE + /* Must create this before anything that inherits from it (X or GTK) */ + console_type_create_xlike (); + console_type_create_redisplay_xlike (); +#endif + #ifdef HAVE_GTK console_type_create_gtk (); console_type_create_select_gtk (); ＠＠ -1837,6 +1843,9 ＠＠ #ifdef HAVE_TTY reinit_console_type_create_tty (); #endif +#ifdef HAVE_XLIKE + reinit_console_type_create_xlike (); +#endif #ifdef HAVE_X_WINDOWS reinit_console_type_create_x (); reinit_console_type_create_device_x (); ＠＠ -1928,6 +1937,7 ＠＠ -- DEFVAR_INT() -- DEFVAR_LISP() -- DEFVAR_BOOL() + -- DEFVAR_SPECIFIER() -- DEFER_GETTEXT() -- staticpro*() -- xmalloc*(), xnew*(), and friends ＠＠ -1956,11 +1966,17 ＠＠ - make_lcrecord_list() -- make_opaque_ptr() -- make_lisp_hash_table() (not allowed in 21.4!) - -- certain specifier creation functions (but be careful; see - glyphs.c for examples) + -- Fmake_specifier() (not allowed in 21.4!) + -- set_specifier_caching() (not allowed in 21.4!) + -- set_specifier_fallback() (not allowed in 21.4!) + + perhaps a few others -- e.g. glyphs.c can call allocate_glyph() in + vars_of_glyphs() because earlier in the same function it does the + necessary work to ensure that glyphs can be created. Other files + cannot safely call allocate_glyph() because they (in general) may + or may not know whether vars_of_glyphs() has already been called + -- there should be no order dependencies between vars_of_foo(). - perhaps a few others. - NO EXTERNAL-FORMAT CONVERSIONS. NB: Initialization or assignment should not be done here to certain ＠＠ -1974,7 +1990,11 ＠＠ /* Now allow Fprovide() statements to be made. */ init_provide_once (); - /* Do that before any specifier creation (esp. vars_of_glyphs()) */ + /* Do this first; it allows for code that asks for the selected + whatever, and for code that loops over all frames/devices/consoles + (none exist currently), such as some of the specifier code. */ + vars_of_console (); + /* Do this first. This allows specifiers to be created. */ vars_of_specifier (); vars_of_abbrev (); ＠＠ -1985,7 +2005,6 ＠＠ vars_of_chartab (); vars_of_cmdloop (); vars_of_cmds (); - vars_of_console (); vars_of_data (); #ifdef DEBUG_XEMACS vars_of_debug (); ＠＠ -2291,35 +2310,6 ＠＠ if (!initialized) { - /* Now initialize any specifier variables. We do this later - because it has some dependence on the vars initialized - above. - - These functions should *only* initialize specifier variables, - and may make use of the following functions/macros in addition - to the ones listed above: - - DEFVAR_SPECIFIER() - Fmake_specifier() - set_specifier_fallback() - set_specifier_caching() - */ - - specifier_vars_of_glyphs (); - specifier_vars_of_glyphs_widget (); - specifier_vars_of_gutter (); -#ifdef HAVE_MENUBARS - specifier_vars_of_menubar (); -#endif - specifier_vars_of_redisplay (); -#ifdef HAVE_SCROLLBARS - specifier_vars_of_scrollbar (); -#endif -#ifdef HAVE_TOOLBARS - specifier_vars_of_toolbar (); -#endif - specifier_vars_of_window (); - /* Now comes all the rest of the variables that couldn't be handled above. There may be dependencies on variables initialized above, and dependencies between one complex_vars_() ＠＠ -2346,14 +2336,6 ＠＠ quite soon, e.g. in complex_vars_of_glyphs_x(). */ inhibit_non_essential_conversion_operations = 0; - /* Depends on specifiers. */ - complex_vars_of_faces (); - - /* This calls allocate_glyph(), which creates specifiers - and also relies on a variable (Vthe_nothing_vector) initialized - above. */ - complex_vars_of_glyphs (); - /* These rely on the glyphs just created in the previous function, and call Fadd_spec_to_specifier(), which relies on various variables initialized above. */ ＠＠ -2886,18 +2868,19 ＠＠ DEFUN_NORETURN ("run-emacs-from-temacs", Frun_emacs_from_temacs, 0, MANY, 0, /* Do not call this. It will reinitialize your XEmacs. You'll be sorry. -*/ -/* If this function is called from startup.el, it will be possible to run - temacs as an editor using 'temacs -batch -l loadup.el run-temacs', instead - of having to dump an emacs and then run that (when debugging emacs itself, - this can be much faster)). [Actually, the speed difference isn't that - much as long as your filesystem is local, and you don't end up with - a dumped version in case you want to rerun it. This function is most - useful when used as part of the `make all-elc' command. --ben] - This will "restart" emacs with the specified command-line arguments. - Martin thinks this function is most useful when using debugging - tools like Purify or tcov that get confused by XEmacs' dumping. */ +If this function is called from startup.el, it will be possible to run +temacs as an editor using 'temacs -batch -l loadup.el run-temacs', instead +of having to dump an emacs and then run that (when debugging emacs itself, +this can be much faster)). [Actually, the speed difference isn't that +much as long as your filesystem is local, and you don't end up with +a dumped version in case you want to rerun it. This function is most +useful when used as part of the `make all-elc' command. --ben] +This will "restart" emacs with the specified command-line arguments. + +Martin thinks this function is most useful when using debugging +tools like Purify or tcov that get confused by XEmacs' dumping. */ + /* (&rest args) */ (int nargs, Lisp_Object *args)) { int i; 1.88.4.1 +531 -138 XEmacs/xemacs/src/eval.c Index: eval.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/eval.c,v retrieving revision 1.88 retrieving revision 1.88.4.1 diff -u -r1.88 -r1.88.4.1 --- eval.c 2005/02/03 16:30:36 1.88 +++ eval.c 2005/02/16 00:42:57 1.88.4.1 ＠＠ -1,7 +1,7 ＠＠ /* Evaluator for XEmacs Lisp interpreter. Copyright (C) 1985-1987, 1992-1994 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 2000, 2001, 2002, 2003, 2004 Ben Wing. + Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 Ben Wing. This file is part of XEmacs. ＠＠ -164,35 +164,114 ＠＠ #define AV_6(av) AV_5(av), av[5] #define AV_7(av) AV_6(av), av[6] #define AV_8(av) AV_7(av), av[7] +#define AV_9(av) AV_8(av), av[8] +#define AV_10(av) AV_9(av), av[9] +#define AV_11(av) AV_10(av), av[10] +#define AV_12(av) AV_11(av), av[11] +#define AV_13(av) AV_12(av), av[12] +#define AV_14(av) AV_13(av), av[13] +#define AV_15(av) AV_14(av), av[14] +#define AV_16(av) AV_15(av), av[15] +#define AV_17(av) AV_16(av), av[16] +#define AV_18(av) AV_17(av), av[17] +#define AV_19(av) AV_18(av), av[18] +#define AV_20(av) AV_19(av), av[19] +#define AV_21(av) AV_20(av), av[20] +#define AV_22(av) AV_21(av), av[21] +#define AV_23(av) AV_22(av), av[22] +#define AV_24(av) AV_23(av), av[23] + +/* If you increase the number of regular or keyword args allowed by subrs, + more cases need to be added to this switch. (But wait - don't increase + the number of regular args - if you really need a SUBR with more than 8 + regular arguments, consider using keywords, or use max_args == MANY. + See the DEFUN macro in lisp.h) */ #define PRIMITIVE_FUNCALL_1(fn, av, ac) \ (((Lisp_Object (*)(EXFUN_##ac)) (fn)) (AV_##ac (av))) -/* If subrs take more than 8 arguments, more cases need to be added - to this switch. (But wait - don't do it - if you really need - a SUBR with more than 8 arguments, use max_args == MANY. - Or better, considering using a property list as one of your args. - See the DEFUN macro in lisp.h) */ -#define PRIMITIVE_FUNCALL(rv, fn, av, ac) do { \ - void (*PF_fn)(void) = (void (*)(void)) fn; \ - Lisp_Object *PF_av = (av); \ - switch (ac) \ - { \ - default:rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 0); break; \ - case 1: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 1); break; \ - case 2: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 2); break; \ - case 3: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 3); break; \ - case 4: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 4); break; \ - case 5: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 5); break; \ - case 6: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 6); break; \ - case 7: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 7); break; \ - case 8: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 8); break; \ - } \ +#define PRIMITIVE_FUNCALL(rv, fn, av, ac) do { \ + void (*PF_fn)(void) = (void (*)(void)) fn; \ + Lisp_Object *PF_av = (av); \ + switch (ac) \ + { \ + default:rv = PRIMITIVE_FUNCALL_1 (PF_fn, PF_av, 0); break; \ + case 1: rv = PRIMITIVE_FUNCALL_1 (PF_fn, PF_av, 1); break; \ + case 2: rv = PRIMITIVE_FUNCALL_1 (PF_fn, PF_av, 2); break; \ + case 3: rv = PRIMITIVE_FUNCALL_1 (PF_fn, PF_av, 3); break; \ + case 4: rv = PRIMITIVE_FUNCALL_1 (PF_fn, PF_av, 4); break; \ + case 5: rv = PRIMITIVE_FUNCALL_1 (PF_fn, PF_av, 5); break; \ + case 6: rv = PRIMITIVE_FUNCALL_1 (PF_fn, PF_av, 6); break; \ + case 7: rv = PRIMITIVE_FUNCALL_1 (PF_fn, PF_av, 7); break; \ + case 8: rv = PRIMITIVE_FUNCALL_1 (PF_fn, PF_av, 8); break; \ + case 9: rv = PRIMITIVE_FUNCALL_1 (PF_fn, PF_av, 9); break; \ + case 10: rv = PRIMITIVE_FUNCALL_1 (PF_fn, PF_av, 10); break; \ + case 11: rv = PRIMITIVE_FUNCALL_1 (PF_fn, PF_av, 11); break; \ + case 12: rv = PRIMITIVE_FUNCALL_1 (PF_fn, PF_av, 12); break; \ + case 13: rv = PRIMITIVE_FUNCALL_1 (PF_fn, PF_av, 13); break; \ + case 14: rv = PRIMITIVE_FUNCALL_1 (PF_fn, PF_av, 14); break; \ + case 15: rv = PRIMITIVE_FUNCALL_1 (PF_fn, PF_av, 15); break; \ + case 16: rv = PRIMITIVE_FUNCALL_1 (PF_fn, PF_av, 16); break; \ + case 17: rv = PRIMITIVE_FUNCALL_1 (PF_fn, PF_av, 17); break; \ + case 18: rv = PRIMITIVE_FUNCALL_1 (PF_fn, PF_av, 18); break; \ + case 19: rv = PRIMITIVE_FUNCALL_1 (PF_fn, PF_av, 19); break; \ + case 20: rv = PRIMITIVE_FUNCALL_1 (PF_fn, PF_av, 20); break; \ + case 21: rv = PRIMITIVE_FUNCALL_1 (PF_fn, PF_av, 21); break; \ + case 22: rv = PRIMITIVE_FUNCALL_1 (PF_fn, PF_av, 22); break; \ + case 23: rv = PRIMITIVE_FUNCALL_1 (PF_fn, PF_av, 23); break; \ + case 24: rv = PRIMITIVE_FUNCALL_1 (PF_fn, PF_av, 24); break; \ + } \ +} while (0) + +/* Unfortunately things don't quite work below with 0 args before the + allow-other args, because you end up with a "void" arg and other + weirdness */ +#define PF1_ALLOW_OTHER_0(fn, av, okc, okv) \ + (((Lisp_Object (*)(EXFUN_ALLOW_OTHER)) (fn)) (okc, okv)) + +#define PF1_ALLOW_OTHER(fn, av, ac, okc, okv) \ + (((Lisp_Object (*)(EXFUN_##ac, EXFUN_ALLOW_OTHER)) (fn)) \ + (AV_##ac (av), okc, okv)) + +#define PRIMITIVE_FUNCALL_ALLOW_OTHER(rv, fn, av, ac, okc, okv) do { \ + void (*PF_fn)(void) = (void (*)(void)) fn; \ + Lisp_Object *PF_av = (av); \ + switch (ac) \ + { \ + default:rv = PF1_ALLOW_OTHER_0 (PF_fn, PF_av, okc, okv); break; \ + case 1: rv = PF1_ALLOW_OTHER (PF_fn, PF_av, 1, okc, okv); break; \ + case 2: rv = PF1_ALLOW_OTHER (PF_fn, PF_av, 2, okc, okv); break; \ + case 3: rv = PF1_ALLOW_OTHER (PF_fn, PF_av, 3, okc, okv); break; \ + case 4: rv = PF1_ALLOW_OTHER (PF_fn, PF_av, 4, okc, okv); break; \ + case 5: rv = PF1_ALLOW_OTHER (PF_fn, PF_av, 5, okc, okv); break; \ + case 6: rv = PF1_ALLOW_OTHER (PF_fn, PF_av, 6, okc, okv); break; \ + case 7: rv = PF1_ALLOW_OTHER (PF_fn, PF_av, 7, okc, okv); break; \ + case 8: rv = PF1_ALLOW_OTHER (PF_fn, PF_av, 8, okc, okv); break; \ + case 9: rv = PF1_ALLOW_OTHER (PF_fn, PF_av, 9, okc, okv); break; \ + case 10: rv = PF1_ALLOW_OTHER (PF_fn, PF_av, 10, okc, okv); break; \ + case 11: rv = PF1_ALLOW_OTHER (PF_fn, PF_av, 11, okc, okv); break; \ + case 12: rv = PF1_ALLOW_OTHER (PF_fn, PF_av, 12, okc, okv); break; \ + case 13: rv = PF1_ALLOW_OTHER (PF_fn, PF_av, 13, okc, okv); break; \ + case 14: rv = PF1_ALLOW_OTHER (PF_fn, PF_av, 14, okc, okv); break; \ + case 15: rv = PF1_ALLOW_OTHER (PF_fn, PF_av, 15, okc, okv); break; \ + case 16: rv = PF1_ALLOW_OTHER (PF_fn, PF_av, 16, okc, okv); break; \ + case 17: rv = PF1_ALLOW_OTHER (PF_fn, PF_av, 17, okc, okv); break; \ + case 18: rv = PF1_ALLOW_OTHER (PF_fn, PF_av, 18, okc, okv); break; \ + case 19: rv = PF1_ALLOW_OTHER (PF_fn, PF_av, 19, okc, okv); break; \ + case 20: rv = PF1_ALLOW_OTHER (PF_fn, PF_av, 20, okc, okv); break; \ + case 21: rv = PF1_ALLOW_OTHER (PF_fn, PF_av, 21, okc, okv); break; \ + case 22: rv = PF1_ALLOW_OTHER (PF_fn, PF_av, 22, okc, okv); break; \ + case 23: rv = PF1_ALLOW_OTHER (PF_fn, PF_av, 23, okc, okv); break; \ + case 24: rv = PF1_ALLOW_OTHER (PF_fn, PF_av, 24, okc, okv); break; \ + } \ } while (0) #define FUNCALL_SUBR(rv, subr, av, ac) \ - PRIMITIVE_FUNCALL (rv, subr_function (subr), av, ac); + PRIMITIVE_FUNCALL (rv, subr_function (subr), av, ac) +#define FUNCALL_SUBR_ALLOW_OTHER(rv, subr, av, ac, okc, okv) \ + PRIMITIVE_FUNCALL_ALLOW_OTHER (rv, subr_function (subr), av, ac, \ + okc, okv) /* This is the list of current catches (and also condition-cases). This is a stack: the most recent catch is at the head of the list. ＠＠ -229,7 +308,7 ＠＠ Lisp_Object Qautoload, Qmacro, Qexit; Lisp_Object Qinteractive, Qcommandp, Qdefun, Qprogn, Qvalues; Lisp_Object Vquit_flag, Vinhibit_quit; -Lisp_Object Qand_rest, Qand_optional; +Lisp_Object Qand_rest, Qand_optional, Qand_key, Qand_allow_other_keys; Lisp_Object Qdebug_on_error, Qstack_trace_on_error; Lisp_Object Qdebug_on_signal, Qstack_trace_on_signal; Lisp_Object Qdebugger; ＠＠ -820,6 +899,7 ＠＠ The remaining args are not evalled at all. If all args return nil, return nil. */ + /* (&rest args) */ (args)) { /* This function can GC */ ＠＠ -839,6 +919,7 ＠＠ The remaining args are not evalled at all. If no arg yields nil, return the last arg's value. */ + /* (&rest args) */ (args)) { /* This function can GC */ ＠＠ -854,11 +935,12 ＠＠ } DEFUN ("if", Fif, 2, UNEVALLED, 0, /* -\(if COND THEN ELSE...): if COND yields non-nil, do THEN, else do ELSE... +if COND yields non-nil, do THEN, else do ELSE... Returns the value of THEN or the value of the last of the ELSE's. THEN must be one expression, but ELSE... can be zero or more expressions. If COND yields nil, and there are no ELSE's, the value is nil. */ + /* (COND THEN &rest ELSE) */ (args)) { /* This function can GC */ ＠＠ -876,9 +958,10 ＠＠ but it helps for bootstrapping to have them ALWAYS defined. */ DEFUN ("when", Fwhen, 1, MANY, 0, /* -\(when COND BODY...): if COND yields non-nil, do BODY, else return nil. +If COND yields non-nil, do BODY, else return nil. BODY can be zero or more expressions. If BODY is nil, return nil. */ + /* (cond &rest body) */ (int nargs, Lisp_Object *args)) { Lisp_Object cond = args[0]; ＠＠ -895,9 +978,10 ＠＠ } DEFUN ("unless", Funless, 1, MANY, 0, /* -\(unless COND BODY...): if COND yields nil, do BODY, else return nil. +If COND yields nil, do BODY, else return nil. BODY can be zero or more expressions. If BODY is nil, return nil. */ + /* (cond &rest body) */ (int nargs, Lisp_Object *args)) { Lisp_Object cond = args[0]; ＠＠ -906,7 +990,7 ＠＠ } DEFUN ("cond", Fcond, 0, UNEVALLED, 0, /* -\(cond CLAUSES...): try each clause until one succeeds. +Try each clause until one succeeds. Each clause looks like (CONDITION BODY...). CONDITION is evaluated and, if the value is non-nil, this clause succeeds: then the expressions in BODY are evaluated and the last one's ＠＠ -915,6 +999,7 ＠＠ If a clause has one element, as in (CONDITION), CONDITION's value if non-nil is returned from the cond-form. */ + /* (&rest clauses) */ (args)) { /* This function can GC */ ＠＠ -938,8 +1023,9 ＠＠ } DEFUN ("progn", Fprogn, 0, UNEVALLED, 0, /* -\(progn BODY...): eval BODY forms sequentially and return value of last one. +Eval BODY forms sequentially and return value of last one. */ + /* (&rest body) */ (args)) { /* This function can GC */ ＠＠ -963,10 +1049,10 ＠＠ DEFUN ("prog1", Fprog1, 1, UNEVALLED, 0, /* Similar to `progn', but the value of the first form is returned. -\(prog1 FIRST BODY...): All the arguments are evaluated sequentially. -The value of FIRST is saved during evaluation of the remaining args, -whose values are discarded. +All the arguments are evaluated sequentially. The value of FIRST is saved +during evaluation of the remaining args, whose values are discarded. */ + /* (first &rest body) */ (args)) { /* This function can GC */ ＠＠ -988,10 +1074,10 ＠＠ DEFUN ("prog2", Fprog2, 2, UNEVALLED, 0, /* Similar to `progn', but the value of the second form is returned. -\(prog2 FIRST SECOND BODY...): All the arguments are evaluated sequentially. -The value of SECOND is saved during evaluation of the remaining args, -whose values are discarded. +All the arguments are evaluated sequentially. The value of SECOND is saved +during evaluation of the remaining args, whose values are discarded. */ + /* (FIRST SECOND &rest BODY) */ (args)) { /* This function can GC */ ＠＠ -1015,12 +1101,13 ＠＠ } DEFUN ("let*", FletX, 1, UNEVALLED, 0, /* -\(let* VARLIST BODY...): bind variables according to VARLIST then eval BODY. +Bind variables according to VARLIST then eval BODY. The value of the last form in BODY is returned. Each element of VARLIST is a symbol (which is bound to nil) or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM). Each VALUEFORM can refer to the symbols already bound by this VARLIST. */ + /* (VARLIST &rest BODY) */ (args)) { /* This function can GC */ ＠＠ -1055,12 +1142,13 ＠＠ } DEFUN ("let", Flet, 1, UNEVALLED, 0, /* -\(let VARLIST BODY...): bind variables according to VARLIST then eval BODY. +Bind variables according to VARLIST then eval BODY. The value of the last form in BODY is returned. Each element of VARLIST is a symbol (which is bound to nil) or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM). All the VALUEFORMs are evalled before any symbols are bound. */ + /* (VARLIST &rest BODY) */ (args)) { /* This function can GC */ ＠＠ -1124,10 +1212,11 ＠＠ } DEFUN ("while", Fwhile, 1, UNEVALLED, 0, /* -\(while TEST BODY...): if TEST yields non-nil, eval BODY... and repeat. +If TEST yields non-nil, eval BODY... and repeat. The order of execution is thus TEST, BODY, TEST, BODY and so on until TEST returns nil. */ + /* (TEST &rest BODY) */ (args)) { /* This function can GC */ ＠＠ -1144,7 +1233,7 ＠＠ } DEFUN ("setq", Fsetq, 0, UNEVALLED, 0, /* -\(setq SYM VAL SYM VAL ...): set each SYM to the value of its VAL. +Set each SYM to the value of its VAL. The symbols SYM are variables; they are literal (not evaluated). The values VAL are expressions; they are evaluated. Thus, (setq x (1+ y)) sets `x' to the value of `(1+ y)'. ＠＠ -1152,6 +1241,7 ＠＠ each VAL can use the new value of variables set earlier in the `setq'. The return value of the `setq' form is the value of the last VAL. */ + /* (&rest sym-val-pairs) */ (args)) { /* This function can GC */ ＠＠ -1178,6 +1268,7 ＠＠ DEFUN ("quote", Fquote, 1, UNEVALLED, 0, /* Return the argument, without evaluating it. `(quote x)' yields `x'. */ + /* (arg) */ (args)) { return XCAR (args); ＠＠ -1188,6 +1279,7 ＠＠ In byte compilation, `function' causes its argument to be compiled. `quote' cannot do that. */ + /* (arg) */ (args)) { return XCAR (args); ＠＠ -1206,10 +1298,11 ＠＠ } DEFUN ("defun", Fdefun, 2, UNEVALLED, 0, /* -\(defun NAME ARGLIST [DOCSTRING] BODY...): define NAME as a function. +Define NAME as a function. The definition is (lambda ARGLIST [DOCSTRING] BODY...). See also the function `interactive'. */ + /* (NAME ARGLIST [DOCSTRING] &rest BODY) */ (args)) { /* This function can GC */ ＠＠ -1218,13 +1311,14 ＠＠ } DEFUN ("defmacro", Fdefmacro, 2, UNEVALLED, 0, /* -\(defmacro NAME ARGLIST [DOCSTRING] BODY...): define NAME as a macro. +Define NAME as a macro. The definition is (macro lambda ARGLIST [DOCSTRING] BODY...). When the macro is called, as in (NAME ARGS...), the function (lambda ARGLIST BODY...) is applied to the list ARGS... as it appears in the expression, and the result should be a form to be evaluated instead of the original. */ + /* (NAME ARGLIST [DOCSTRING] &rest BODY) */ (args)) { /* This function can GC */ ＠＠ -1233,7 +1327,7 ＠＠ } DEFUN ("defvar", Fdefvar, 1, UNEVALLED, 0, /* -\(defvar SYMBOL INITVALUE DOCSTRING): define SYMBOL as a variable. +Define SYMBOL as a variable. You are not required to define a variable in order to use it, but the definition can supply documentation and an initial value in a way that tags can recognize. ＠＠ -1251,6 +1345,7 ＠＠ In lisp-interaction-mode defvar is treated as defconst. */ + /* (SYMBOL INITVALUE DOCSTRING) */ (args)) { /* This function can GC */ ＠＠ -1288,8 +1383,7 ＠＠ } DEFUN ("defconst", Fdefconst, 2, UNEVALLED, 0, /* -\(defconst SYMBOL INITVALUE DOCSTRING): define SYMBOL as a constant -variable. +Define SYMBOL as a constant variable. The intent is that programs do not change this value, but users may. Always sets the value of SYMBOL to the result of evalling INITVALUE. If SYMBOL is buffer-local, its default value is what is set; ＠＠ -1304,6 +1398,7 ＠＠ Since `defconst' unconditionally assigns the variable, it would override the user's choice. */ + /* (SYMBOL INITVALUE DOCSTRING) */ (args)) { /* This function can GC */ ＠＠ -1348,7 +1443,7 ＠＠ ((INTP (documentation) && XINT (documentation) < 0) || (STRINGP (documentation) && - (string_byte (documentation, 0) == '*')) || + (string_byte_at (documentation, 0) == '*')) || /* If (STRING . INTEGER), a negative integer means a user variable. */ (CONSP (documentation) ＠＠ -1470,12 +1565,13 ＠＠ #endif /* ERROR_CHECK_TRAPPING_PROBLEMS */ DEFUN ("catch", Fcatch, 1, UNEVALLED, 0, /* -\(catch TAG BODY...): eval BODY allowing nonlocal exits using `throw'. +Eval BODY allowing nonlocal exits using `throw'. TAG is evalled to get the tag to use. Then the BODY is executed. Within BODY, (throw TAG) with same (`eq') tag exits BODY and this `catch'. If no throw happens, `catch' returns the value of the last BODY form. If a throw happens, it specifies the value to return from `catch'. */ + /* (TAG &rest BODY) */ (args)) { /* This function can GC */ ＠＠ -1724,11 +1820,11 ＠＠ DEFUN ("unwind-protect", Funwind_protect, 1, UNEVALLED, 0, /* Do BODYFORM, protecting with UNWINDFORMS. -Usage looks like (unwind-protect BODYFORM UNWINDFORMS...). If BODYFORM completes normally, its value is returned after executing the UNWINDFORMS. If BODYFORM exits nonlocally, the UNWINDFORMS are executed anyway. */ + /* (BODYFORM &rest UNWINDFORMS) */ (args)) { /* This function can GC */ ＠＠ -2011,14 +2107,13 ＠＠ DEFUN ("condition-case", Fcondition_case, 2, UNEVALLED, 0, /* Regain control when an error is signalled. -Usage looks like (condition-case VAR BODYFORM HANDLERS...). Executes BODYFORM and returns its value if no error happens. Each element of HANDLERS looks like (CONDITION-NAME BODY...) where the BODY is made of Lisp expressions. A typical usage of `condition-case' looks like this: -(condition-case nil +\(condition-case nil ;; you need a progn here if you want more than one statement ... (progn (do-something) ＠＠ -2056,7 +2151,8 ＠＠ Lisp stack, bindings, etc. as they were when `signal' was called, rather than when the handler was set, use `call-with-condition-handler'. */ - (args)) + /* (VAR BODYFORM &rest HANDLERS) */ + (args)) { /* This function can GC */ Lisp_Object var = XCAR (args); ＠＠ -2067,7 +2163,6 ＠＠ DEFUN ("call-with-condition-handler", Fcall_with_condition_handler, 2, MANY, 0, /* Regain control when an error is signalled, without popping the stack. -Usage looks like (call-with-condition-handler HANDLER FUNCTION &rest ARGS). This function is similar to `condition-case', but the handler is invoked with the same environment (Lisp stack, bindings, catches, condition-cases) that was current when `signal' was called, rather than when the handler ＠＠ -2081,6 +2176,7 ＠＠ \(It continues to look for handlers established earlier than this one, and invokes the standard error-handler if none is found.) */ + /* (HANDLER FUNCTION &rest ARGS) */ (int nargs, Lisp_Object *args)) /* Note! Args side-effected! */ { /* This function can GC */ ＠＠ -3018,7 +3114,8 ＠＠ Return t if FUNCTION makes provisions for interactive calling. This means it contains a description for how to read arguments to give it. The value is nil for an invalid function or a symbol with no function -definition. +definition. Anything that is `commandp' can be executed using +`command-execute'. Interactively callable functions include ＠＠ -3468,6 +3565,160 ＠＠ } } +/* Return position of keyword in list of keywords in SUBR, or -1 if not + found. */ +static inline int +keyword_pos_in_list (Lisp_Subr *subr, Lisp_Object keyword) +{ + switch (subr->num_keywords) + { + case 0: return -1; + /* I guess that with 4 or fewer it's best to just check by hand. + Else do binary search. */ + case 4: if (EQ (subr->keyword_syms[3], keyword)) return 3; + case 3: if (EQ (subr->keyword_syms[2], keyword)) return 2; + case 2: if (EQ (subr->keyword_syms[1], keyword)) return 1; + case 1: return EQ (subr->keyword_syms[0], keyword) ? 0 : -1; + default: + { +#if 0 /* #### this requires that the keywords are sorted, which we haven't + yet implemented */ + void *keywordval = LISP_TO_VOID (keyword); + int left = 0, right = subr->num_keywords; + + /* binary search algorithm taken from extents.c. NOTE: getting + a binary search correct is VERY tricky! don't try writing it + from scratch. (ideally, we would be writing in C++ and could + use the rich facilities of the standard container library. + dream on.) */ + while (left != right) + { + /* RIGHT might not point to a valid extent (i.e. it's at the end + of the list), so NEWPOS must round down. */ + int newpos = (left + right) >> 1; + if (LISP_TO_VOID (subr->keyword_syms[newpos]) < keywordval) + left = newpos + 1; + else + right = newpos; + } + + return EQ (subr->keyword_syms[left], keyword) ? left : -1; +#else + int i; + for (i = 0; i < subr->num_keywords; i++) + { + if (EQ (keyword, subr->keyword_syms[i])) + return i; + } + return -1; +#endif + } + } +} + +static Lisp_Object +funcall_subr_with_keywords (Lisp_Subr *subr, int nargs, Lisp_Object *args) +{ + Lisp_Object spacious_args[SUBR_MAX_ARGS + SUBR_MAX_KEYWORD_ARGS]; + Lisp_Object *p = spacious_args; + int i; + + int max_args = KEYWORD_NEGATIVE_ARG_CONVERTER - subr->max_args; + + /* Required args */ + for (i = 0; i < subr->min_args; i++) + { + *p++ = *args++; + nargs--; + } + /* Optional args: must check for keywords to distinguish optional + from keyword args */ + for (; nargs > 0 && i < max_args; nargs--, i++) + { + if (!(nargs & 1)) + { + if (keyword_pos_in_list (subr, *args) >= 0) + goto outer_break; + + /* #### ideally, we need to know what the unevalled version of + #### this arg was! was it a variable that generated the + #### keyword, or the keyword itself? we would need to + #### institute some sort of "boxing" where whenever a keyword + #### is generated from something other than itself, and + #### funcall is about to be called, we "box" the keyword + #### inside of another object. that's a sign that it can't be + #### a keyword. the byte code should do this boxing. so + #### should eval, when dealing with a function with keywords + #### -- or when calling `funcall' or `apply'. `funcall' + #### should also recognize when it's calling itself and keep + #### the boxing going. THE BOXING MUST NEVER ESCAPE TO LISP. + + but this still isn't totally reliable, and adds even less + determinacy, as well as extra overhead; probably not worth + it. */ + *p++ = *args++; + } + } + + outer_break: + /* Add unspecified optional args */ + for (; i < max_args; i++) + *p++ = Qnil; + + /* Do keyword args */ + if (nargs & 1) + { + invalid_keyword_args: + invalid_argument_2 ("Invalid keyword arguments", wrap_subr (subr), + Flist (nargs, args)); + } + + for (i = 0; i < subr->num_keywords; i++) + p[i] = subr->keyword_props & KEYWORD_DEFAULT_UNBOUND ? Qunbound : Qnil; + if (!(subr->keyword_props & KEYWORD_ALLOW_OTHER)) + { + Lisp_Object val; + + for (; nargs > 0; nargs -= 2, args += 2) + { + int pos = keyword_pos_in_list (subr, *args); + if (pos >= 0) + p[pos] = args[1]; + else + goto invalid_keyword_args; + } + + FUNCALL_SUBR (val, subr, spacious_args, max_args + subr->num_keywords); + return val; + } + else + { + int num_other_keywords = 0; + /* Can't be more keywords than are in the arguments */ + Lisp_Object_pair *other_keywords = + alloca_array (Lisp_Object_pair, nargs >> 1); + Lisp_Object val; + + for (; nargs > 0; nargs -= 2, args += 2) + { + int pos = keyword_pos_in_list (subr, *args); + if (pos >= 0) + p[pos] = args[1]; + else + { + other_keywords[num_other_keywords].key = *args; + other_keywords[num_other_keywords].value = args[1]; + num_other_keywords++; + } + } + + FUNCALL_SUBR_ALLOW_OTHER (val, subr, spacious_args, + max_args + subr->num_keywords, + num_other_keywords, other_keywords); + return val; + } +} + DEFUN ("eval", Feval, 1, 1, 0, /* Evaluate FORM and return its value. */ ＠＠ -3571,7 +3822,8 ＠＠ if (nargs < subr->min_args) goto wrong_number_of_arguments; - if (max_args == UNEVALLED) /* Optimize for the common case */ + if (max_args == UNEVALLED) /* Optimize for the common case; see + comment in Ffuncall() */ { backtrace.evalargs = 0; PROFILE_ENTER_FUNCTION (); ＠＠ -3609,7 +3861,7 ＠＠ UNGCPRO; } - else if (max_args == MANY) + else if (max_args <= MANY) /* MANY or keyword args */ { /* Pass a vector of evaluated arguments */ struct gcpro gcpro1; ＠＠ -3630,10 +3882,20 ＠＠ backtrace.args = args; backtrace.nargs = nargs; - PROFILE_ENTER_FUNCTION (); - val = (((Lisp_Object (*) (int, Lisp_Object *)) subr_function (subr)) + if (max_args == MANY) + { + PROFILE_ENTER_FUNCTION (); + val = + (((Lisp_Object (*) (int, Lisp_Object *)) subr_function (subr)) (nargs, args)); - PROFILE_EXIT_FUNCTION (); + PROFILE_EXIT_FUNCTION (); + } + else + { + PROFILE_ENTER_FUNCTION (); + val = funcall_subr_with_keywords (subr, nargs, args); + PROFILE_EXIT_FUNCTION (); + } UNGCPRO; } ＠＠ -3762,6 +4024,7 ＠＠ Call first argument as a function, passing the remaining arguments to it. Thus, (funcall 'cons 'x 'y) returns (x . y). */ + /* (function &rest args) */ (int nargs, Lisp_Object *args)) { /* This function can GC */ ＠＠ -3838,9 +4101,20 ＠＠ { Lisp_Subr *subr = XSUBR (fun); int max_args = subr->max_args; - Lisp_Object spacious_args[SUBR_MAX_ARGS]; - if (fun_nargs == max_args) /* Optimize for the common case */ + if (fun_nargs == max_args) /* Optimize for the common case; note that + the common case here is completely + different from `eval', where the common + case is UNEVALLED. Eval is called on + raw Lisp, where if/while/setq and other + special forms will abound. Funcall is + called most commonly from byte code, + where the special forms have already + been converted into inline byte code, + the most common functions have opcodes + of their own and are called directly, + and funcall is used to handle all other + functions. */ { funcall_subr: PROFILE_ENTER_FUNCTION (); ＠＠ -3853,6 +4127,7 ＠＠ } else if (fun_nargs < max_args) { + Lisp_Object spacious_args[SUBR_MAX_ARGS]; Lisp_Object *p = spacious_args; /* Default optionals to nil */ ＠＠ -3870,6 +4145,12 ＠＠ val = SUBR_FUNCTION (subr, MANY) (fun_nargs, fun_args); PROFILE_EXIT_FUNCTION (); } + else if (max_args <= KEYWORD_NEGATIVE_ARG_CONVERTER) + { + PROFILE_ENTER_FUNCTION (); + val = funcall_subr_with_keywords (subr, fun_nargs, fun_args); + PROFILE_EXIT_FUNCTION (); + } else if (max_args == UNEVALLED) /* Can't funcall a special form */ { goto invalid_function; ＠＠ -3948,41 +4229,23 ＠＠ return Qnil; } +/* Given anything that's a valid function, indirect it through symbols, + autoloads, and macro conses (i.e. cons of 'macro and a function). + Either signal an error or return a subr, compiled function, or + lambda. */ + static Lisp_Object -function_argcount (Lisp_Object function, int function_min_args_p) +indirect_function_try_harder (Lisp_Object function) { Lisp_Object orig_function = function; - Lisp_Object arglist; retry: if (SYMBOLP (function)) function = indirect_function (function, 1); - - if (SUBRP (function)) - { - /* Using return with the ?: operator tickles a DEC CC compiler bug. */ - if (function_min_args_p) - return Fsubr_min_args (function); - else - return Fsubr_max_args (function); - } - else if (COMPILED_FUNCTIONP (function)) - { - Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (function); - - if (!OPAQUEP (f->instructions)) - /* Lazily munge the instructions into a more efficient form */ - /* Needed to set max_args */ - optimize_compiled_function (function); - if (function_min_args_p) - return make_int (f->min_args); - else if (f->max_args == MANY) - return Qnil; - else - return make_int (f->max_args); - } + if (SUBRP (function) || COMPILED_FUNCTIONP (function)) + return function; else if (CONSP (function)) { Lisp_Object funcar = XCAR (function); ＠＠ -4000,45 +4263,73 ＠＠ goto retry; } else if (EQ (funcar, Qlambda)) - { - arglist = Fcar (XCDR (function)); - } + return function; else - { - goto invalid_function; - } + goto invalid_function; } else { invalid_function: - return signal_invalid_function_error (orig_function); + function = signal_invalid_function_error (orig_function); + goto retry; } +} - { - int argcount = 0; +static Lisp_Object +function_argcount (Lisp_Object function, int function_min_args_p) +{ + function = indirect_function_try_harder (function); - EXTERNAL_LIST_LOOP_2 (arg, arglist) - { - if (EQ (arg, Qand_optional)) - { - if (function_min_args_p) - break; - } - else if (EQ (arg, Qand_rest)) - { - if (function_min_args_p) - break; - else - return Qnil; - } - else - { - argcount++; - } - } + if (SUBRP (function)) + { + /* Using return with the ?: operator tickles a DEC CC compiler bug. */ + if (function_min_args_p) + return Fsubr_min_args (function); + else + return Fsubr_max_args (function); + } + else if (COMPILED_FUNCTIONP (function)) + { + Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (function); + + if (!OPAQUEP (f->instructions)) + /* Lazily munge the instructions into a more efficient form */ + /* Needed to set max_args */ + optimize_compiled_function (function); - return make_int (argcount); - } + if (function_min_args_p) + return make_int (f->min_args); + else if (f->max_args == MANY) + return Qnil; + else + return make_int (f->max_args); + } + else + { + int argcount = 0; + + EXTERNAL_LIST_LOOP_2 (arg, Fcar (XCDR (function))) + { + if (EQ (arg, Qand_optional)) + { + if (function_min_args_p) + break; + } + else if (EQ (arg, Qand_rest)) + { + if (function_min_args_p) + break; + else + return Qnil; + } + else + { + argcount++; + } + } + + return make_int (argcount); + } } DEFUN ("function-min-args", Ffunction_min_args, 1, 1, 0, /* ＠＠ -4058,8 +4349,14 ＠＠ Return the maximum number of arguments a function may be called with. The function may be any form that can be passed to `funcall', any special form, or any macro. -If the function takes an arbitrary number of arguments or is -a built-in special form, nil is returned. + +If the function takes an arbitrary number of arguments, allows keywords, or +is a built-in special form, nil is returned. (The justification for +returning nil when keywords are allowed is for compatibility with existing +code, which otherwise will wrongly assume that keyword args are exceeding +the maximum. To find out the maximum number of non-keyword args, use +`function-max-non-keyword-args'. To find out the names of allowed +keywords, use `function-keyword-args'.) To check if a function can be called with a specified number of arguments, use `function-allows-args'. ＠＠ -4069,11 +4366,115 ＠＠ return function_argcount (function, 0); } +DEFUN ("function-max-non-keyword-args", Ffunction_max_non_keyword_args, 1, 1, + 0, /* +Return the maximum number of non-keyword args a function may be called with. +The function may be any form that can be passed to `funcall', +any special form, or any macro. + +If the function takes an arbitrary number of arguments or is +a built-in special form, nil is returned. + +This differs from `function-max-args' when keywords are allowed -- that +function returns nil in such a case, but this one returns the maximum +number of "positional" arguments (non-keyword arguments) allowed. See also +`function-keyword-args'. +*/ + (function)) +{ + function = indirect_function_try_harder (function); + + if (SUBRP (function)) + return make_int (XSUBR (function)->num_keywords); + else if (COMPILED_FUNCTIONP (function)) + return Qzero; /* #### no support yet */ + else + { + int argcount = 0; + int saw_key = 0; + + EXTERNAL_LIST_LOOP_2 (arg, Fcar (XCDR (function))) + { + if (EQ (arg, Qand_key)) + saw_key = 1; + else if (EQ (arg, Qand_allow_other_keys)) + ; + else if (saw_key) + argcount++; + } + + return make_int (argcount); + } +} + +DEFUN ("function-keyword-args", Ffunction_keyword_args, 1, 1, + 0, /* +Return a list of allowed keywords a function may be called with. +The function may be any form that can be passed to `funcall', +any special form, or any macro. + +See also `function-allows-other-keywords-p'. +*/ + (function)) +{ + function = indirect_function_try_harder (function); + + if (SUBRP (function)) + return Flist (XSUBR (function)->num_keywords, + XSUBR (function)->keyword_syms); + else if (COMPILED_FUNCTIONP (function)) + return Qnil; /* #### no support yet */ + else + { + Lisp_Object result = Qnil; + int saw_key = 0; + + EXTERNAL_LIST_LOOP_2 (arg, Fcar (XCDR (function))) + { + if (EQ (arg, Qand_key)) + saw_key = 1; + else if (EQ (arg, Qand_allow_other_keys)) + ; + else if (saw_key) + result = Fcons (arg, result); + } + + return Fnreverse (result); + } +} + +DEFUN ("function-allows-other-keywords-p", Ffunction_allows_other_keywords_p, + 1, 1, 0, /* +Return non-nil if a function allows other keywords than explicitly specified. +This means its arg list includes &allow-other-keys. + +See also `function-keyword-args'. +*/ + (function)) +{ + function = indirect_function_try_harder (function); + + if (SUBRP (function)) + return XSUBR (function)->keyword_props & KEYWORD_ALLOW_OTHER ? Qt : Qnil; + else if (COMPILED_FUNCTIONP (function)) + return Qnil; /* #### no support yet */ + else + { + EXTERNAL_LIST_LOOP_2 (arg, Fcar (XCDR (function))) + { + if (EQ (arg, Qand_allow_other_keys)) + return Qt; + } + return Qnil; + } +} +  DEFUN ("apply", Fapply, 2, MANY, 0, /* Call FUNCTION with the remaining args, using the last arg as a list of args. Thus, (apply '+ 1 2 '(3 4)) returns 10. */ + /* (function &rest args) */ (int nargs, Lisp_Object *args)) { /* This function can GC */ ＠＠ -4101,24 +4502,11 ＠＠ if (SYMBOLP (fun)) fun = indirect_function (fun, 0); - - if (SUBRP (fun)) - { - Lisp_Subr *subr = XSUBR (fun); - int max_args = subr->max_args; - - if (numargs < subr->min_args - || (max_args >= 0 && max_args < numargs)) - { - /* Let funcall get the error */ - } - else if (max_args > numargs) - { - /* Avoid having funcall cons up yet another new vector of arguments - by explicitly supplying nil's for optional values */ - funcall_nargs += (max_args - numargs); - } - } + /* We used to have code here to check for ungiven optional args in subrs + and add nil arguments "to avoid extra consing in Ffuncall"; but we + don't do any allocation at all in Ffuncall now, and the code would + have gotten a lot trickier with keywords, so I've deleted the + junk. --ben */ else if (UNBOUNDP (fun)) { /* Let funcall get the error */ ＠＠ -4143,10 +4531,6 ＠＠ { funcall_args [i] = XCAR (spread_arg); } - /* Supply nil for optional args (to subrs) */ - for (; i < funcall_nargs; i++) - funcall_args[i] = Qnil; - RETURN_UNGCPRO (Ffuncall (funcall_nargs, funcall_args)); } ＠＠ -4226,6 +4610,7 ＠＠ To make a hook variable buffer-local, use `make-local-hook', not `make-local-variable'. */ + /* (hook &rest other-hooks) */ (int nargs, Lisp_Object *args)) { REGISTER int i; ＠＠ -4250,6 +4635,7 ＠＠ To make a hook variable buffer-local, use `make-local-hook', not `make-local-variable'. */ + /* (hook &rest args) */ (int nargs, Lisp_Object *args)) { return run_hook_with_args (nargs, args, RUN_HOOKS_TO_COMPLETION); ＠＠ -4266,6 +4652,7 ＠＠ To make a hook variable buffer-local, use `make-local-hook', not `make-local-variable'. */ + /* (hook &rest args) */ (int nargs, Lisp_Object *args)) { return run_hook_with_args (nargs, args, RUN_HOOKS_UNTIL_SUCCESS); ＠＠ -4282,6 +4669,7 ＠＠ To make a hook variable buffer-local, use `make-local-hook', not `make-local-variable'. */ + /* (hook &rest args) */ (int nargs, Lisp_Object *args)) { return run_hook_with_args (nargs, args, RUN_HOOKS_UNTIL_FAILURE); ＠＠ -6451,6 +6839,8 ＠＠ DEFSYMBOL (Qmacro); defsymbol (&Qand_rest, "&rest"); defsymbol (&Qand_optional, "&optional"); + defsymbol (&Qand_key, "&key"); + defsymbol (&Qand_allow_other_keys, "&allow-other-keys"); /* Note that the process code also uses Qexit */ DEFSYMBOL (Qexit); DEFSYMBOL (Qsetq); ＠＠ -6501,6 +6891,9 ＠＠ DEFSUBR (Ffunctionp); DEFSUBR (Ffunction_min_args); DEFSUBR (Ffunction_max_args); + DEFSUBR (Ffunction_max_non_keyword_args); + DEFSUBR (Ffunction_keyword_args); + DEFSUBR (Ffunction_allows_other_keywords_p); DEFSUBR (Frun_hooks); DEFSUBR (Frun_hook_with_args); DEFSUBR (Frun_hook_with_args_until_success); 1.82.4.1 +109 -117 XEmacs/xemacs/src/event-Xt.c Index: event-Xt.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/event-Xt.c,v retrieving revision 1.82 retrieving revision 1.82.4.1 diff -u -r1.82 -r1.82.4.1 --- event-Xt.c 2005/01/24 23:33:52 1.82 +++ event-Xt.c 2005/02/16 00:42:59 1.82.4.1 ＠＠ -71,8 +71,6 ＠＠ extern int mswindows_is_blocking; #endif -/* used in glyphs-x.c */ -void enqueue_focus_event (Widget wants_it, Lisp_Object frame, int in_p); static void handle_focus_event_1 (struct frame *f, int in_p); static void handle_focus_event_2 (Window w, struct frame *f, int in_p); ＠＠ -116,10 +114,10 ＠＠ }; static Lisp_Object x_keysym_to_emacs_keysym (KeySym keysym, int simple_p); -void emacs_Xt_mapping_action (Widget w, XEvent *event); +void Xt_mapping_action (Widget w, XEvent *event); void debug_process_finalization (Lisp_Process *p); -void emacs_Xt_event_handler (Widget wid, XtPointer closure, XEvent *event, - Boolean *continue_to_dispatch); +void Xt_event_handler (Widget wid, XtPointer closure, XEvent *event, + Boolean *continue_to_dispatch); static int last_quit_check_signal_tick_count; ＠＠ -391,7 +389,7 ＠＠ Fclrhash (hash_table); else xd->x_keysym_map_hash_table = hash_table = - make_lisp_hash_table (128, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); + make_lisp_hash_table (128, hash_table_non_weak, HASH_TABLE_EQUAL); for (keysym = xd->x_keysym_map, keysyms_per_code = xd->x_keysym_map_keysyms_per_code, ＠＠ -851,7 +849,7 ＠＠ Of course, we DO worry about it, so we need a special translation. */ void -emacs_Xt_mapping_action (Widget UNUSED (w), XEvent *event) +Xt_mapping_action (Widget UNUSED (w), XEvent *event) { struct device *d = get_device_from_display (event->xany.display); ＠＠ -1361,12 +1359,13 ＠＠ return 0; /* not for us */ GCPRO4 (l_type, l_data, l_dndlist, l_item); - set_event_type (emacs_event, misc_user_event); + set_event_type (emacs_event, drop_event); SET_EVENT_CHANNEL (emacs_event, wrap_frame (frame)); SET_EVENT_TIMESTAMP (emacs_event, DEVICE_X_LAST_SERVER_TIMESTAMP (d)); - state=DndDragButtons (x_event); + state = DndDragButtons (x_event); + if (state & ShiftMask) modifiers |= XEMACS_MOD_SHIFT; if (state & ControlMask) modifiers |= XEMACS_MOD_CONTROL; if (state & xd->MetaMask) modifiers |= XEMACS_MOD_META; ＠＠ -1385,12 +1384,12 ＠＠ if (state & Button2Mask) button = Button2; if (state & Button1Mask) button = Button1; - SET_EVENT_MISC_USER_MODIFIERS (emacs_event, modifiers); - SET_EVENT_MISC_USER_BUTTON (emacs_event, button); + SET_EVENT_DROP_MODIFIERS (emacs_event, modifiers); + SET_EVENT_DROP_BUTTON (emacs_event, button); DndDropCoordinates (FRAME_X_TEXT_WIDGET (frame), x_event, - &(EVENT_MISC_USER_X (emacs_event)), - &(EVENT_MISC_USER_Y (emacs_event))); + &(EVENT_DROP_X (emacs_event)), + &(EVENT_DROP_Y (emacs_event))); DndGetData (x_event, &data, &size); dtype = DndDataType (x_event); ＠＠ -1462,10 +1461,8 ＠＠ break; } - SET_EVENT_MISC_USER_FUNCTION (emacs_event, - Qdragdrop_drop_dispatch); - SET_EVENT_MISC_USER_OBJECT (emacs_event, - Fcons (l_type, l_dndlist)); + SET_EVENT_DROP_DATA_TYPE (emacs_event, l_type); + SET_EVENT_DROP_DATA (emacs_event, l_dndlist); UNGCPRO; ＠＠ -1593,7 +1590,7 ＠＠ } /* We have the focus now. See comment in - emacs_Xt_handle_widget_losing_focus (). */ + Xt_handle_widget_losing_focus (). */ if (in_p) widget_with_focus = NULL; ＠＠ -1614,10 +1611,9 ＠＠ } /* Create a synthetic X focus event. */ -void emacs_Xt_enqueue_focus_event (Widget wants_it, Lisp_Object frame, - int in_p); +void Xt_enqueue_focus_event (Widget wants_it, Lisp_Object frame, int in_p); void -emacs_Xt_enqueue_focus_event (Widget wants_it, Lisp_Object frame, int in_p) +Xt_enqueue_focus_event (Widget wants_it, Lisp_Object frame, int in_p) { Lisp_Object emacs_event = Fmake_event (Qnil, Qnil); Lisp_Event *ev = XEVENT (emacs_event); ＠＠ -1641,9 +1637,9 ＠＠ with keyboard focus when FocusOut is processed, and then, when a widget gets unmapped, it calls this function to restore focus if appropriate. */ -void emacs_Xt_handle_widget_losing_focus (struct frame *f, Widget losing_widget); +void Xt_handle_widget_losing_focus (struct frame *f, Widget losing_widget); void -emacs_Xt_handle_widget_losing_focus (struct frame *f, Widget losing_widget) +Xt_handle_widget_losing_focus (struct frame *f, Widget losing_widget) { if (losing_widget == widget_with_focus) { ＠＠ -1653,9 +1649,9 ＠＠ /* This is called from the external-widget code */ -void emacs_Xt_handle_focus_event (XEvent *event); +void Xt_handle_focus_event (XEvent *event); void -emacs_Xt_handle_focus_event (XEvent *event) +Xt_handle_focus_event (XEvent *event) { struct device *d = get_device_from_display (event->xany.display); struct frame *f; ＠＠ -1821,8 +1817,7 ＠＠ using a dialog box instead of the minibuffer if there are unsaved buffers. */ - enqueue_misc_user_event (frame, Qeval, - list3 (Qdelete_frame, frame, Qt)); + enqueue_notify_event (NOTIFY_CLOSE_FRAME, frame); } else if (event->xclient.message_type == DEVICE_XATOM_WM_PROTOCOLS (d) && (Atom) event->xclient.data.l[0] == DEVICE_XATOM_WM_TAKE_FOCUS (d)) ＠＠ -1863,14 +1858,13 ＠＠ XtAppProcessEvent can get called from the following places: - emacs_Xt_next_event () - this is normal event processing, almost + Xt_next_event () - this is normal event processing, almost any non-X event will take precedence and this means that we cannot rely on it to do the right thing at the right time for widget display. - emacs_Xt_drain_queue () - this happens when SIGIO gets tripped, - processing the event queue allows C-g to be checked for. It gets - called from emacs_Xt_event_pending_p (). #### Update this comment. + Xt_drain_queue () - this happens when SIGIO gets tripped, + processing the event queue allows C-g to be checked for. In order to solve this I have tried introducing a list primitive - dispatch-non-command-events - which forces processing of X events ＠＠ -1886,7 +1880,7 ＠＠ does the wrong thing. */ static void -emacs_Xt_force_event_pending (struct frame *f) +Xt_force_event_pending (struct frame *f) { XEvent event; ＠＠ -1905,38 +1899,38 ＠＠ } static void -emacs_Xt_format_magic_event (Lisp_Event *event, Lisp_Object pstream) +Xt_format_magic_event (Lisp_Event *event, Lisp_Object pstream) { - Lisp_Object console = CDFW_CONSOLE (EVENT_CHANNEL (event)); + Lisp_Object console = Fcdfw_console (EVENT_CHANNEL (event)); if (CONSOLE_X_P (XCONSOLE (console))) write_c_string (pstream, x_event_name ((EVENT_MAGIC_X_EVENT (event)).type)); } static int -emacs_Xt_compare_magic_event (Lisp_Event *e1, Lisp_Event *e2) +Xt_compare_magic_event (Lisp_Event *e1, Lisp_Event *e2) { - if (CONSOLE_X_P (XCONSOLE (CDFW_CONSOLE (EVENT_CHANNEL (e1)))) && - CONSOLE_X_P (XCONSOLE (CDFW_CONSOLE (EVENT_CHANNEL (e2))))) + if (CONSOLE_X_P (XCONSOLE (Fcdfw_console (EVENT_CHANNEL (e1)))) && + CONSOLE_X_P (XCONSOLE (Fcdfw_console (EVENT_CHANNEL (e2))))) return ((EVENT_MAGIC_X_EVENT (e1)).xany.serial == (EVENT_MAGIC_X_EVENT (e2)).xany.serial); - if (CONSOLE_X_P (XCONSOLE (CDFW_CONSOLE (EVENT_CHANNEL (e1)))) || - CONSOLE_X_P (XCONSOLE (CDFW_CONSOLE (EVENT_CHANNEL (e2))))) + if (CONSOLE_X_P (XCONSOLE (Fcdfw_console (EVENT_CHANNEL (e1)))) || + CONSOLE_X_P (XCONSOLE (Fcdfw_console (EVENT_CHANNEL (e2))))) return 0; return 1; } static Hashcode -emacs_Xt_hash_magic_event (Lisp_Event *e) +Xt_hash_magic_event (Lisp_Event *e) { - Lisp_Object console = CDFW_CONSOLE (EVENT_CHANNEL (e)); + Lisp_Object console = Fcdfw_console (EVENT_CHANNEL (e)); if (CONSOLE_X_P (XCONSOLE (console))) return (EVENT_MAGIC_X_EVENT (e)).xany.serial; return 0; } static void -emacs_Xt_handle_magic_event (Lisp_Event *emacs_event) +Xt_handle_magic_event (Lisp_Event *emacs_event) { /* This function can GC */ XEvent *event = &EVENT_MAGIC_X_EVENT (emacs_event); ＠＠ -1968,7 +1962,7 ＠＠ event->xexpose.width, event->xexpose.height) && - !find_matching_subwindow (f, event->xexpose.x, event->xexpose.y, + !find_matching_subcontrol (f, event->xexpose.x, event->xexpose.y, event->xexpose.width, event->xexpose.height)) redisplay_redraw_exposed_area (f, event->xexpose.x, event->xexpose.y, event->xexpose.width, ＠＠ -2105,7 +2099,7 ＠＠ } static int -emacs_Xt_add_timeout (EMACS_TIME thyme) +Xt_add_timeout (EMACS_TIME thyme) { struct Xt_timeout *timeout = Blocktype_alloc (the_Xt_timeout_blocktype); EMACS_TIME current_time; ＠＠ -2127,7 +2121,7 ＠＠ } static void -emacs_Xt_remove_timeout (int id) +Xt_remove_timeout (int id) { struct Xt_timeout *timeout, *t2; ＠＠ -2193,7 +2187,8 ＠＠ completed_timeouts = completed_timeouts->next; /* timeout events have nil as channel */ set_event_type (emacs_event, timeout_event); - SET_EVENT_TIMESTAMP_ZERO (emacs_event); /* #### wrong!! */ + SET_EVENT_TIMESTAMP (emacs_event, + current_time_from_event_channel_or_else (Qnil)); SET_EVENT_TIMEOUT_INTERVAL_ID (emacs_event, timeout->id); SET_EVENT_TIMEOUT_FUNCTION (emacs_event, Qnil); SET_EVENT_TIMEOUT_OBJECT (emacs_event, Qnil); ＠＠ -2353,7 +2348,7 ＠＠ } static void -emacs_Xt_select_process (Lisp_Process *process, int doin, int doerr) +Xt_select_process (Lisp_Process *process, int doin, int doerr) { Lisp_Object proc; int infd, errfd; ＠＠ -2368,7 +2363,7 ＠＠ } static void -emacs_Xt_unselect_process (Lisp_Process *process, int doin, int doerr) +Xt_unselect_process (Lisp_Process *process, int doin, int doerr) { int infd, errfd; ＠＠ -2381,13 +2376,13 ＠＠ } static void -emacs_Xt_create_io_streams (void *inhandle, void *outhandle, - void *errhandle, Lisp_Object *instream, - Lisp_Object *outstream, - Lisp_Object *errstream, - USID *in_usid, - USID *err_usid, - int flags) +Xt_create_io_streams (void *inhandle, void *outhandle, + void *errhandle, Lisp_Object *instream, + Lisp_Object *outstream, + Lisp_Object *errstream, + USID *in_usid, + USID *err_usid, + int flags) { event_stream_unixoid_create_io_streams (inhandle, outhandle, errhandle, instream, outstream, ＠＠ -2399,11 +2394,11 ＠＠ } static void -emacs_Xt_delete_io_streams (Lisp_Object instream, - Lisp_Object outstream, - Lisp_Object errstream, - USID *in_usid, - USID *err_usid) +Xt_delete_io_streams (Lisp_Object instream, + Lisp_Object outstream, + Lisp_Object errstream, + USID *in_usid, + USID *err_usid) { event_stream_unixoid_delete_io_streams (instream, outstream, errstream, in_usid, err_usid); ＠＠ -2451,7 +2446,8 ＠＠ process_events_occurred--; /* process events have nil as channel */ set_event_type (emacs_event, process_event); - SET_EVENT_TIMESTAMP_ZERO (emacs_event); /* #### */ + SET_EVENT_TIMESTAMP (emacs_event, + current_time_from_event_channel_or_else (Qnil)); SET_EVENT_PROCESS_PROCESS (emacs_event, process); return; } ＠＠ -2460,7 +2456,7 ＠＠ } static void -emacs_Xt_select_console (struct console *con) +Xt_select_console (struct console *con) { Lisp_Object console; int infd; ＠＠ -2474,7 +2470,7 ＠＠ } static void -emacs_Xt_unselect_console (struct console *con) +Xt_unselect_console (struct console *con) { int infd; ＠＠ -2747,30 +2743,25 ＠＠ /* get the next event from Xt */ /************************************************************************/ -/* This business exists because menu events "happen" when - menubar_selection_callback() is called from somewhere deep - within XtAppProcessEvent in emacs_Xt_next_event(). The - callback needs to terminate the modal loop in that function - or else it will continue waiting until another event is - received. +/* Menu events "happen" when menubar_selection_callback() is called from + somewhere deep within XtAppProcessEvent in Xt_next_event(). The + callback needs to terminate the modal loop in that function or else it + will continue waiting until another event is received. - Same business applies to scrollbar events. */ + Same business applies to scrollbar events. -void -signal_special_Xt_user_event (Lisp_Object channel, Lisp_Object function, - Lisp_Object object) -{ - Lisp_Object event = Fmake_event (Qnil, Qnil); + See more general comment in event-stream.c, near enqueue_activate_event(). - XSET_EVENT_TYPE (event, misc_user_event); - XSET_EVENT_CHANNEL (event, channel); - XSET_EVENT_MISC_USER_FUNCTION (event, function); - XSET_EVENT_MISC_USER_OBJECT (event, object); - enqueue_dispatch_event (event); -} + #### What's the deal with + + DEVICE_X_MOUSE_TIMESTAMP (d) = DEVICE_X_GLOBAL_MOUSE_TIMESTAMP (d); + which various functions claim needs to be done before invoking + enqueue_dispatch_event(), maybe indirectly? +*/ + static void -emacs_Xt_next_event (Lisp_Event *emacs_event) +Xt_next_event (Lisp_Event *emacs_event) { we_didnt_get_an_event: ＠＠ -2879,10 +2870,10 ＠＠ } void -emacs_Xt_event_handler (Widget UNUSED (wid), - XtPointer UNUSED (closure), - XEvent *event, - Boolean *UNUSED (continue_to_dispatch)) +Xt_event_handler (Widget UNUSED (wid), + XtPointer UNUSED (closure), + XEvent *event, + Boolean *UNUSED (continue_to_dispatch)) { Lisp_Object emacs_event = Fmake_event (Qnil, Qnil); ＠＠ -2902,7 +2893,7 ＠＠ /************************************************************************/ static void -emacs_Xt_drain_queue (void) +Xt_drain_queue (void) { Lisp_Object devcons, concons; if (!in_modal_loop) ＠＠ -2943,7 +2934,7 ＠＠ Display *d = DEVICE_X_DISPLAY (dev); Lisp_Object event; - emacs_Xt_drain_queue (); + Xt_drain_queue (); EVENT_CHAIN_LOOP (event, dispatch_event_queue) if (XEVENT_TYPE (event) == magic_event) ＠＠ -2958,7 +2949,7 ＠＠ } static int -emacs_Xt_current_event_timestamp (struct console *c) +Xt_current_event_timestamp (struct console *c) { /* semi-yuck. */ Lisp_Object devs = CONSOLE_DEVICE_LIST (c); ＠＠ -2968,6 +2959,8 ＠＠ else { struct device *d = XDEVICE (XCAR (devs)); + if (!DEVICE_X_P (d)) + return 0; return DEVICE_X_LAST_SERVER_TIMESTAMP (d); } } ＠＠ -3133,10 +3126,10 ＠＠  /************************************************************************/ -/* handle focus changes for native widgets */ +/* handle focus changes for native widgets */ /************************************************************************/ static void -emacs_Xt_event_widget_focus_in (Widget w, +Xt_event_widget_focus_in (Widget w, XEvent *event, String *UNUSED (params), Cardinal *UNUSED (num_params)) ＠＠ -3148,21 +3141,21 ＠＠ } static void -emacs_Xt_event_widget_focus_out (Widget UNUSED (w), - XEvent *UNUSED (event), - String *UNUSED (params), - Cardinal *UNUSED (num_params)) +Xt_event_widget_focus_out (Widget UNUSED (w), + XEvent *UNUSED (event), + String *UNUSED (params), + Cardinal *UNUSED (num_params)) { } static XtActionsRec widgetActionsList[] = { - {"widget-focus-in", emacs_Xt_event_widget_focus_in }, - {"widget-focus-out", emacs_Xt_event_widget_focus_out }, + {"widget-focus-in", Xt_event_widget_focus_in }, + {"widget-focus-out", Xt_event_widget_focus_out }, }; static void -emacs_Xt_event_add_widget_actions (XtAppContext ctx) +Xt_event_add_widget_actions (XtAppContext ctx) { XtAppAddActions (ctx, widgetActionsList, 2); } ＠＠ -3184,24 +3177,23 ＠＠ reinit_vars_of_event_Xt (void) { Xt_event_stream = xnew_and_zero (struct event_stream); - Xt_event_stream->event_pending_p = emacs_Xt_event_pending_p; - Xt_event_stream->force_event_pending_cb= emacs_Xt_force_event_pending; - Xt_event_stream->next_event_cb = emacs_Xt_next_event; - Xt_event_stream->handle_magic_event_cb = emacs_Xt_handle_magic_event; - Xt_event_stream->format_magic_event_cb = emacs_Xt_format_magic_event; - Xt_event_stream->compare_magic_event_cb= emacs_Xt_compare_magic_event; - Xt_event_stream->hash_magic_event_cb = emacs_Xt_hash_magic_event; - Xt_event_stream->add_timeout_cb = emacs_Xt_add_timeout; - Xt_event_stream->remove_timeout_cb = emacs_Xt_remove_timeout; - Xt_event_stream->select_console_cb = emacs_Xt_select_console; - Xt_event_stream->unselect_console_cb = emacs_Xt_unselect_console; - Xt_event_stream->select_process_cb = emacs_Xt_select_process; - Xt_event_stream->unselect_process_cb = emacs_Xt_unselect_process; - Xt_event_stream->drain_queue_cb = emacs_Xt_drain_queue; - Xt_event_stream->create_io_streams_cb = emacs_Xt_create_io_streams; - Xt_event_stream->delete_io_streams_cb = emacs_Xt_delete_io_streams; - Xt_event_stream->current_event_timestamp_cb = - emacs_Xt_current_event_timestamp; + + EVENT_STREAM_HAS_METHOD (Xt, force_event_pending); + EVENT_STREAM_HAS_METHOD (Xt, next_event); + EVENT_STREAM_HAS_METHOD (Xt, handle_magic_event); + EVENT_STREAM_HAS_METHOD (Xt, format_magic_event); + EVENT_STREAM_HAS_METHOD (Xt, compare_magic_event); + EVENT_STREAM_HAS_METHOD (Xt, hash_magic_event); + EVENT_STREAM_HAS_METHOD (Xt, add_timeout); + EVENT_STREAM_HAS_METHOD (Xt, remove_timeout); + EVENT_STREAM_HAS_METHOD (Xt, select_console); + EVENT_STREAM_HAS_METHOD (Xt, unselect_console); + EVENT_STREAM_HAS_METHOD (Xt, select_process); + EVENT_STREAM_HAS_METHOD (Xt, unselect_process); + EVENT_STREAM_HAS_METHOD (Xt, drain_queue); + EVENT_STREAM_HAS_METHOD (Xt, create_io_streams); + EVENT_STREAM_HAS_METHOD (Xt, delete_io_streams); + EVENT_STREAM_HAS_METHOD (Xt, current_event_timestamp); the_Xt_timeout_blocktype = Blocktype_new (struct Xt_timeout_blocktype); ＠＠ -3290,7 +3282,7 ＠＠ XtCacheByDisplay, EmacsFreeXIMStyles); #endif /* XIM_XLIB */ /* Add extra actions to native widgets to handle focus and friends. */ - emacs_Xt_event_add_widget_actions (Xt_app_con); + Xt_event_add_widget_actions (Xt_app_con); /* insert the visual inheritance patch/hack described above */ orig_shell_init_proc = shellClassRec.core_class.initialize; 1.30.4.1 +106 -102 XEmacs/xemacs/src/event-gtk.c Index: event-gtk.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/event-gtk.c,v retrieving revision 1.30 retrieving revision 1.30.4.1 diff -u -r1.30 -r1.30.4.1 --- event-gtk.c 2005/01/24 23:33:52 1.30 +++ event-gtk.c 2005/02/16 00:43:00 1.30.4.1 ＠＠ -70,7 +70,7 ＠＠ #include "event-gtk.h" -static struct event_stream *gtk_event_stream; +static struct event_stream *GTK_event_stream; #ifdef WIN32_ANY extern int mswindows_is_blocking; ＠＠ -88,7 +88,7 ＠＠ static Lisp_Object gtk_keysym_to_emacs_keysym (guint keysym, int simple_p); void debug_process_finalization (struct Lisp_Process *p); -gboolean emacs_gtk_event_handler (GtkWidget *wid /* unused */, +gboolean GTK_event_handler (GtkWidget *wid /* unused */, GdkEvent *event, gpointer closure /* unused */); ＠＠ -229,9 +229,9 ＠＠ } static void -emacs_gtk_format_magic_event (Lisp_Event *emacs_event, Lisp_Object pstream) +GTK_format_magic_event (Lisp_Event *emacs_event, Lisp_Object pstream) { - Lisp_Object console = CDFW_CONSOLE (EVENT_CHANNEL (emacs_event)); + Lisp_Object console = Fcdfw_console (EVENT_CHANNEL (emacs_event)); if (CONSOLE_GTK_P (XCONSOLE (console))) write_c_string (pstream, ＠＠ -239,23 +239,23 ＠＠ } static int -emacs_gtk_compare_magic_event (Lisp_Event *e1, Lisp_Event *e2) +GTK_compare_magic_event (Lisp_Event *e1, Lisp_Event *e2) { - if (CONSOLE_GTK_P (XCONSOLE (CDFW_CONSOLE (EVENT_CHANNEL (e1)))) && - CONSOLE_GTK_P (XCONSOLE (CDFW_CONSOLE (EVENT_CHANNEL (e2))))) + if (CONSOLE_GTK_P (XCONSOLE (Fcdfw_console (EVENT_CHANNEL (e1)))) && + CONSOLE_GTK_P (XCONSOLE (Fcdfw_console (EVENT_CHANNEL (e2))))) return (!memcmp (&EVENT_MAGIC_GDK_EVENT (e1), &EVENT_MAGIC_GDK_EVENT (e2), sizeof (GdkEvent))); - if (CONSOLE_GTK_P (XCONSOLE (CDFW_CONSOLE (EVENT_CHANNEL (e1)))) || - CONSOLE_GTK_P (XCONSOLE (CDFW_CONSOLE (EVENT_CHANNEL (e2))))) + if (CONSOLE_GTK_P (XCONSOLE (Fcdfw_console (EVENT_CHANNEL (e1)))) || + CONSOLE_GTK_P (XCONSOLE (Fcdfw_console (EVENT_CHANNEL (e2))))) return 0; return 1; } static Hashcode -emacs_gtk_hash_magic_event (Lisp_Event *e) +GTK_hash_magic_event (Lisp_Event *e) { - Lisp_Object console = CDFW_CONSOLE (EVENT_CHANNEL (e)); + Lisp_Object console = Fcdfw_console (EVENT_CHANNEL (e)); if (CONSOLE_GTK_P (XCONSOLE (console))) return memory_hash (&EVENT_MAGIC_GDK_EVENT (e), sizeof (GdkEvent)); ＠＠ -263,7 +263,7 ＠＠ } static void -emacs_gtk_handle_magic_event (struct Lisp_Event *emacs_event) +GTK_handle_magic_event (struct Lisp_Event *emacs_event) { /* This function can GC */ GdkEvent *event = &EVENT_MAGIC_GDK_EVENT (emacs_event); ＠＠ -555,7 +555,7 ＠＠ } static int -emacs_gtk_add_timeout (EMACS_TIME thyme) +GTK_add_timeout (EMACS_TIME thyme) { struct GTK_timeout *timeout = Blocktype_alloc (the_GTK_timeout_blocktype); EMACS_TIME current_time; ＠＠ -577,7 +577,7 ＠＠ } static void -emacs_gtk_remove_timeout (int id) +GTK_remove_timeout (int id) { struct GTK_timeout *timeout, *t2; ＠＠ -643,7 +643,8 ＠＠ completed_timeouts = completed_timeouts->next; /* timeout events have nil as channel */ set_event_type (emacs_event, timeout_event); - SET_EVENT_TIMESTAMP_ZERO (emacs_event); /* #### wrong!! */ + SET_EVENT_TIMESTAMP (emacs_event, + current_time_from_event_channel_or_else (Qnil)); SET_EVENT_TIMEOUT_INTERVAL_ID (emacs_event, timeout->id); SET_EVENT_TIMEOUT_FUNCTION (emacs_event, Qnil); SET_EVENT_TIMEOUT_OBJECT (emacs_event, Qnil); ＠＠ -802,7 +803,7 ＠＠ } static void -emacs_gtk_select_process (Lisp_Process *process, int doin, int doerr) +GTK_select_process (Lisp_Process *process, int doin, int doerr) { Lisp_Object proc; int infd, errfd; ＠＠ -817,7 +818,7 ＠＠ } static void -emacs_gtk_unselect_process (Lisp_Process *process, int doin, int doerr) +GTK_unselect_process (Lisp_Process *process, int doin, int doerr) { int infd, errfd; ＠＠ -830,13 +831,13 ＠＠ } static void -emacs_gtk_create_io_streams (void *inhandle, void *outhandle, - void *errhandle, Lisp_Object *instream, - Lisp_Object *outstream, - Lisp_Object *errstream, - USID *in_usid, - USID *err_usid, - int flags) +GTK_create_io_streams (void *inhandle, void *outhandle, + void *errhandle, Lisp_Object *instream, + Lisp_Object *outstream, + Lisp_Object *errstream, + USID *in_usid, + USID *err_usid, + int flags) { event_stream_unixoid_create_io_streams (inhandle, outhandle, errhandle, instream, outstream, ＠＠ -848,11 +849,11 ＠＠ } static void -emacs_gtk_delete_io_streams (Lisp_Object instream, - Lisp_Object outstream, - Lisp_Object errstream, - USID *in_usid, - USID *err_usid) +GTK_delete_io_streams (Lisp_Object instream, + Lisp_Object outstream, + Lisp_Object errstream, + USID *in_usid, + USID *err_usid) { event_stream_unixoid_delete_io_streams (instream, outstream, errstream, in_usid, err_usid); ＠＠ -899,7 +900,8 ＠＠ process_events_occurred--; /* process events have nil as channel */ set_event_type (emacs_event, process_event); - SET_EVENT_TIMESTAMP_ZERO (emacs_event); /* #### */ + SET_EVENT_TIMESTAMP (emacs_event, + current_time_from_event_channel_or_else (Qnil)); SET_EVENT_PROCESS_PROCESS (emacs_event, process); return; } ＠＠ -908,20 +910,21 ＠＠ } static void -emacs_gtk_select_console (struct console *con) +GTK_select_console (struct console *con) { Lisp_Object console; int infd; if (CONSOLE_GTK_P (con)) - return; /* Gtk consoles are automatically selected for when we initialize them */ + return; /* Gtk consoles are automatically selected for when we + initialize them */ infd = event_stream_unixoid_select_console (con); console = wrap_console (con); select_filedesc (infd, console); } static void -emacs_gtk_unselect_console (struct console *con) +GTK_unselect_console (struct console *con) { Lisp_Object console; int infd; ＠＠ -995,12 +998,17 ＠＠ GCPRO4 (l_type, l_data, l_dndlist, l_item); - set_event_type (ev, misc_user_event); - SET_EVENT_CHANNEL (ev, wrap_frame (f)); + set_event_type (ev, drop_event); SET_EVENT_TIMESTAMP (ev, time); - SET_EVENT_MISC_USER_X (ev, x); - SET_EVENT_MISC_USER_Y (ev, y); + ev->channel = wrap_frame (f); + + SET_EVENT_DROP_X (ev, x); + SET_EVENT_DROP_Y (ev, y); + + SET_EVENT_DROP_BUTTON (ev, #### fill in); + SET_EVENT_DROP_MODIFIERS (ev, #### fill in); + if (data->type == preferred_targets[TARGET_URI_LIST]) { /* newline-separated list of URLs */ ＠＠ -1060,8 +1068,8 ＠＠ } - SET_EVENT_MISC_USER_FUNCTION (ev, Qdragdrop_drop_dispatch); - SET_EVENT_MISC_USER_OBJECT (ev, Fcons (l_type, l_dndlist)); + SET_EVENT_DROP_DATA_TYPE (ev, l_type); + SET_EVENT_DROP_DATA (ev, l_dndlist); UNGCPRO; ＠＠ -1148,30 +1156,8 ＠＠ /* get the next event from gtk */ /************************************************************************/ -/* This business exists because menu events "happen" when - menubar_selection_callback() is called from somewhere deep - within XtAppProcessEvent in emacs_Xt_next_event(). The - callback needs to terminate the modal loop in that function - or else it will continue waiting until another event is - received. - - Same business applies to scrollbar events. */ - -void -signal_special_gtk_user_event (Lisp_Object channel, Lisp_Object function, - Lisp_Object object) -{ - Lisp_Object event = Fmake_event (Qnil, Qnil); - - XSET_EVENT_TYPE (event, misc_user_event); - XSET_EVENT_CHANNEL (event, channel); - XSET_EVENT_MISC_USER_FUNCTION (event, function); - XSET_EVENT_MISC_USER_OBJECT (event, object); - enqueue_dispatch_event (event); -} - static void -emacs_gtk_next_event (struct Lisp_Event *emacs_event) +GTK_next_event (struct Lisp_Event *emacs_event) { we_didnt_get_an_event: ＠＠ -1489,43 +1475,43 ＠＠ static gboolean generic_event_handler (GtkWidget *widget, GdkEvent *event) { - Lisp_Object emacs_event = Qnil; - if (!GTK_IS_XEMACS (widget)) + Lisp_Object emacs_event = Qnil; + if (!GTK_IS_XEMACS (widget)) { - stderr_out ("Got a %s event for a non-XEmacs widget\n",event_name (event)); - return (FALSE); + stderr_out ("Got a %s event for a non-XEmacs widget\n",event_name (event)); + return (FALSE); } - emacs_event = Fmake_event (Qnil, Qnil); + emacs_event = Fmake_event (Qnil, Qnil); - if (gtk_event_to_emacs_event (GTK_XEMACS_FRAME (widget), event, XEVENT (emacs_event))) + if (gtk_event_to_emacs_event (GTK_XEMACS_FRAME (widget), event, XEVENT (emacs_event))) { - enqueue_dispatch_event (emacs_event); - return (TRUE); + enqueue_dispatch_event (emacs_event); + return (TRUE); } - else + else { - Fdeallocate_event (emacs_event); + Fdeallocate_event (emacs_event); } - return (FALSE); + return (FALSE); } gint -emacs_gtk_key_event_handler (GtkWidget *widget, GdkEventKey *event) +GTK_key_event_handler (GtkWidget *widget, GdkEventKey *event) { - return (generic_event_handler (widget, (GdkEvent *) event)); + return (generic_event_handler (widget, (GdkEvent *) event)); } gint -emacs_gtk_button_event_handler (GtkWidget *widget, GdkEventButton *event) +GTK_button_event_handler (GtkWidget *widget, GdkEventButton *event) { - return (generic_event_handler (widget, (GdkEvent *) event)); + return (generic_event_handler (widget, (GdkEvent *) event)); } gint -emacs_gtk_motion_event_handler (GtkWidget *widget, GdkEventMotion *event) +GTK_motion_event_handler (GtkWidget *widget, GdkEventMotion *event) { - return (generic_event_handler (widget, (GdkEvent *) event)); + return (generic_event_handler (widget, (GdkEvent *) event)); } gboolean ＠＠ -1566,7 +1552,7 ＠＠ } #undef FROB - emacs_event->event_type = magic_event; + set_event_type (emacs_event, magic_event); emacs_event->channel = wrap_frame (frame); if (ignore_p) ＠＠ -1590,14 +1576,14 ＠＠ #include <gdk/gdkx.h> static void -emacs_gtk_drain_queue (void) +GTK_drain_queue (void) { /* We can't just spin through here and wait for GTKs idea of the event queue to get empty, or the queue never gets drained. The situation is as follows. A process event gets signalled, we put it on the queue, then we go into Fnext_event(), which calls - emacs_gtk_drain_queue(). But gtk_events_pending() will always return + GTK_drain_queue(). But gtk_events_pending() will always return TRUE if there are file-descriptor (aka our process) events pending. Using GDK_events_pending() only shows us windowing system events. ＠＠ -1612,13 +1598,28 ＠＠ } static void -emacs_gtk_force_event_pending (struct frame* UNUSED (f)) +GTK_force_event_pending (struct frame* UNUSED (f)) { #if 0 stderr_out ("Force event pending called on frame %p!\n", f); #endif } +static int +GTK_current_event_timestamp (struct console *c) +{ + /* semi-yuck. */ + Lisp_Object devs = CONSOLE_DEVICE_LIST (c); + + if (NILP (devs)) + return 0; + else + { + struct device *d = XDEVICE (XCAR (devs)); + return DEVICE_GTK_LAST_SERVER_TIMESTAMP (d); + } +} +  /************************************************************************/ /* initialization */ ＠＠ -1634,23 +1635,26 ＠＠ void reinit_vars_of_event_gtk (void) { - gtk_event_stream = xnew_and_zero (struct event_stream); - gtk_event_stream->event_pending_p = emacs_gtk_event_pending_p; - gtk_event_stream->next_event_cb = emacs_gtk_next_event; - gtk_event_stream->handle_magic_event_cb= emacs_gtk_handle_magic_event; - gtk_event_stream->format_magic_event_cb= emacs_gtk_format_magic_event; - gtk_event_stream->compare_magic_event_cb= emacs_gtk_compare_magic_event; - gtk_event_stream->hash_magic_event_cb = emacs_gtk_hash_magic_event; - gtk_event_stream->add_timeout_cb = emacs_gtk_add_timeout; - gtk_event_stream->remove_timeout_cb = emacs_gtk_remove_timeout; - gtk_event_stream->select_console_cb = emacs_gtk_select_console; - gtk_event_stream->unselect_console_cb = emacs_gtk_unselect_console; - gtk_event_stream->select_process_cb = emacs_gtk_select_process; - gtk_event_stream->unselect_process_cb = emacs_gtk_unselect_process; - gtk_event_stream->drain_queue_cb = emacs_gtk_drain_queue; - gtk_event_stream->create_io_streams_cb= emacs_gtk_create_io_streams; - gtk_event_stream->delete_io_streams_cb= emacs_gtk_delete_io_streams; - gtk_event_stream->force_event_pending_cb= emacs_gtk_force_event_pending; + GTK_event_stream = xnew_and_zero (struct event_stream); + + EVENT_STREAM_HAS_METHOD (GTK, event_pending_p); + EVENT_STREAM_HAS_METHOD (GTK, next_event); + EVENT_STREAM_HAS_METHOD (gtk, enqueue_dispatch_event); + EVENT_STREAM_HAS_METHOD (GTK, handle_magic_event); + EVENT_STREAM_HAS_METHOD (GTK, format_magic_event); + EVENT_STREAM_HAS_METHOD (GTK, compare_magic_event); + EVENT_STREAM_HAS_METHOD (GTK, hash_magic_event); + EVENT_STREAM_HAS_METHOD (GTK, add_timeout); + EVENT_STREAM_HAS_METHOD (GTK, remove_timeout); + EVENT_STREAM_HAS_METHOD (GTK, select_console); + EVENT_STREAM_HAS_METHOD (GTK, unselect_console); + EVENT_STREAM_HAS_METHOD (GTK, select_process); + EVENT_STREAM_HAS_METHOD (GTK, unselect_process); + EVENT_STREAM_HAS_METHOD (GTK, drain_queue); + EVENT_STREAM_HAS_METHOD (GTK, create_io_streams); + EVENT_STREAM_HAS_METHOD (GTK, delete_io_streams); + EVENT_STREAM_HAS_METHOD (GTK, force_event_pending); + EVENT_STREAM_HAS_METHOD (GTK, current_event_timestamp); the_GTK_timeout_blocktype = Blocktype_new (struct GTK_timeout_blocktype); ＠＠ -1677,7 +1681,7 ＠＠ pending_timeouts = 0; completed_timeouts = 0; - event_stream = gtk_event_stream; + event_stream = GTK_event_stream; #if 0 /* Shut GDK the hell up */ ＠＠ -1774,7 +1778,7 ＠＠ else { xd->x_keysym_map_hashtable = hashtable = - make_lisp_hash_table (128, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); + make_lisp_hash_table (128, hash_table_non_weak, HASH_TABLE_EQUAL); } for (keysym = xd->x_keysym_map, 1.103.4.1 +70 -133 XEmacs/xemacs/src/event-msw.c Index: event-msw.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/event-msw.c,v retrieving revision 1.103 retrieving revision 1.103.4.1 diff -u -r1.103 -r1.103.4.1 --- event-msw.c 2005/01/28 02:36:24 1.103 +++ event-msw.c 2005/02/16 00:43:01 1.103.4.1 ＠＠ -671,6 +671,7 ＠＠ LSTREAM_HAS_METHOD (ntpipe_shove, was_blocked_p); LSTREAM_HAS_METHOD (ntpipe_shove, closer); } +  /************************************************************************/ /* Winsock I/O stream */ ＠＠ -909,22 +910,13 ＠＠ /* Dispatch queue management */ /************************************************************************/ -static int -mswindows_user_event_p (Lisp_Event *sevt) -{ - return (sevt->event_type == key_press_event - || sevt->event_type == button_press_event - || sevt->event_type == button_release_event - || sevt->event_type == misc_user_event); -} - /* * Add an emacs event to the proper dispatch queue */ -void +static void mswindows_enqueue_dispatch_event (Lisp_Object event) { - int user_p = mswindows_user_event_p (XEVENT (event)); + int user_p = user_event_p (event); if (user_p) enqueue_dispatch_event (event); else ＠＠ -935,24 +927,6 ＠＠ qxePostMessage (NULL, XM_BUMPQUEUE, 0, 0); } -/* - * Add a misc-user event to the dispatch queue. - */ -void -mswindows_enqueue_misc_user_event (Lisp_Object channel, Lisp_Object function, - Lisp_Object object) -{ - Lisp_Object event = Fmake_event (Qnil, Qnil); - - XSET_EVENT_TYPE (event, misc_user_event); - XSET_EVENT_CHANNEL (event, channel); - XSET_EVENT_TIMESTAMP (event, GetTickCount()); - XSET_EVENT_MISC_USER_FUNCTION (event, function); - XSET_EVENT_MISC_USER_OBJECT (event, object); - - mswindows_enqueue_dispatch_event (event); -} - void mswindows_enqueue_magic_event (HWND hwnd, UINT msg) { ＠＠ -1022,7 +996,7 ＠＠ { SetCapture (hwnd); /* we need this to make sure the main window regains the focus - from control subwindows */ + from child controls */ if (GetFocus() != hwnd) { SetFocus (hwnd); ＠＠ -1311,7 +1285,7 ＠＠ { struct mswindows_frame *msframe; - /* hdc will be NULL unless this is a subwindow - in which case we + /* hdc will be NULL unless this is a child - in which case we shouldn't have received a paint message for it here. */ assert (msg.wParam == 0); ＠＠ -1333,7 +1307,7 ＠＠ } static void -emacs_mswindows_drain_queue (void) +mswindows_drain_queue (void) { /* This can call Lisp */ mswindows_drain_windows_queue (0); ＠＠ -1347,7 +1321,7 ＠＠ * an event of a type specified by USER_P is retrieved. * * - * Used by emacs_mswindows_event_pending_p and emacs_mswindows_next_event + * Used by mswindows_event_pending_p and mswindows_next_event */ static void mswindows_need_event (int badly_p) ＠＠ -1586,7 +1560,7 ＠＠ int ix = active - WAIT_OBJECT_0; /* look for a stream console event; see - emacs_mswindows_select_console below. */ + mswindows_select_console below. */ LIST_LOOP_3 (porca_troia, Vconsole_list, vcontail) { struct console *con = XCONSOLE (porca_troia); ＠＠ -2070,9 +2044,6 ＠＠ Ibyte *end; struct gcpro gcpro1, gcpro2; Lisp_Object l_dndlist = Qnil; - Lisp_Object emacs_event = Fmake_event (Qnil, Qnil); - Lisp_Object frmcons, devcons, concons; - Lisp_Event *event = XEVENT (emacs_event); DdeGetData (hdata, (LPBYTE) extcmd, len, 0); DdeFreeDataHandle (hdata); ＠＠ -2120,30 +2091,13 ＠＠ l_dndlist = build_intstring (cmd); xfree (cmd, Ibyte *); } - GCPRO2 (emacs_event, l_dndlist); - - /* Find a mswindows frame */ - event->channel = Qnil; - FRAME_LOOP_NO_BREAK (frmcons, devcons, concons) - { - Lisp_Object frame = XCAR (frmcons); - if (FRAME_TYPE_P (XFRAME (frame), mswindows)) - event->channel = frame; - }; - assert (!NILP (event->channel)); - - SET_EVENT_TIMESTAMP (event, GetTickCount()); - SET_EVENT_TYPE (event, misc_user_event); - SET_EVENT_MISC_USER_BUTTON (event, 1); - SET_EVENT_MISC_USER_MODIFIERS (event, 0); - SET_EVENT_MISC_USER_X (event, -1); - SET_EVENT_MISC_USER_Y (event, -1); - SET_EVENT_MISC_USER_FUNCTION (event, - Qdragdrop_drop_dispatch); - SET_EVENT_MISC_USER_OBJECT (event, - Fcons (Qdragdrop_URL, - Fcons (l_dndlist, Qnil))); - mswindows_enqueue_dispatch_event (emacs_event); + /* #### I don't think enqueue_drop_event() does anything that might + call GC */ + GCPRO1 (l_dndlist); + /* Find a mswindows frame, since we're just getting a generic + interprocess message */ + enqueue_drop_event (wrap_frame (selected_frame ()), + Qdragdrop_URL, l_dndlist, 1, 0, -1, -1); UNGCPRO; return (HDDEDATA) DDE_FACK; } ＠＠ -2523,8 +2477,7 ＠＠ case WM_CLOSE: fobj = mswindows_find_frame (hwnd); - mswindows_enqueue_misc_user_event (fobj, Qeval, list3 (Qdelete_frame, fobj, - Qt)); + enqueue_notify_event (NOTIFY_CLOSE_FRAME, fobj); break; case WM_KEYUP: ＠＠ -3174,10 +3127,8 ＠＠ case WM_CANCELMODE: ReleaseCapture (); - /* Queue a `cancel-mode-internal' misc user event, so mouse - selection would be canceled if any */ - mswindows_enqueue_misc_user_event (mswindows_find_frame (hwnd), - Qcancel_mode_internal, Qnil); + enqueue_notify_event (NOTIFY_CANCEL_MODE, + mswindows_find_frame (hwnd)); break; case WM_NOTIFY: ＠＠ -3237,7 +3188,7 ＠＠ break; case WM_PAINT: - /* hdc will be NULL unless this is a subwindow - in which case we + /* hdc will be NULL unless this is a child - in which case we shouldn't have received a paint message for it here. */ assert (wParam == 0); ＠＠ -3537,7 +3488,7 ＠＠ HWND hwndScrollBar = (HWND) lParam; struct gcpro gcpro1, gcpro2; - mswindows_handle_scrollbar_event (hwndScrollBar, code, pos); + mswindows_handle_scrollbar_event (hwndScrollBar, code, pos); GCPRO2 (emacs_event, fobj); if (UNBOUNDP (mswindows_pump_outstanding_events ())) /* Can GC */ { ＠＠ -3684,27 +3635,13 ＠＠ POINT point; Lisp_Object l_dndlist = Qnil, l_item = Qnil; - struct gcpro gcpro1, gcpro2, gcpro3; - - emacs_event = Fmake_event (Qnil, Qnil); - event = XEVENT (emacs_event); + struct gcpro gcpro1, gcpro2; - GCPRO3 (emacs_event, l_dndlist, l_item); + GCPRO2 (l_dndlist, l_item); if (!DragQueryPoint ((HDROP) wParam, &point)) point.x = point.y = -1; /* outside client area */ - XSET_EVENT_TYPE (emacs_event, misc_user_event); - XSET_EVENT_CHANNEL (emacs_event, mswindows_find_frame(hwnd)); - XSET_EVENT_TIMESTAMP (emacs_event, GetMessageTime()); - XSET_EVENT_MISC_USER_BUTTON (emacs_event, 1); - XSET_EVENT_MISC_USER_MODIFIERS (emacs_event, - mswindows_modifier_state (NULL, (DWORD) -1, 0)); - XSET_EVENT_MISC_USER_X (emacs_event, point.x); - XSET_EVENT_MISC_USER_Y (emacs_event, point.y); - XSET_EVENT_MISC_USER_FUNCTION (emacs_event, - Qdragdrop_drop_dispatch); - filecount = qxeDragQueryFile ((HDROP) wParam, 0xffffffff, NULL, 0); for (i = 0; i < filecount; i++) { ＠＠ -3744,9 +3681,10 ＠＠ DragFinish ((HDROP) wParam); - SET_EVENT_MISC_USER_OBJECT (event, - Fcons (Qdragdrop_URL, l_dndlist)); - mswindows_enqueue_dispatch_event (emacs_event); + enqueue_drop_event (mswindows_find_frame (hwnd), Qdragdrop_URL, + l_dndlist, 1 /* #### Should try harder */, + mswindows_modifier_state (NULL, (DWORD) -1, 0), + point.x, point.y); UNGCPRO; } break; ＠＠ -4173,7 +4111,7 ＠＠ /************************************************************************/ static int -emacs_mswindows_add_timeout (EMACS_TIME thyme) +mswindows_add_timeout (EMACS_TIME thyme) { int milliseconds; EMACS_TIME current_time; ＠＠ -4201,7 +4139,7 ＠＠ } static void -emacs_mswindows_remove_timeout (int id) +mswindows_remove_timeout (int id) { if (KillTimer (NULL, id)) --mswindows_pending_timers_count; ＠＠ -4216,15 +4154,15 ＠＠ /* If `user_p' is false, then return whether there are any win32, timeout, * or subprocess events pending (that is, whether - * emacs_mswindows_next_event() would return immediately without blocking). + * mswindows_next_event() would return immediately without blocking). * * if `user_p' is true, then return whether there are any *user generated* * events available (that is, whether there are keyboard or mouse-click * events ready to be read). This also implies that - * emacs_mswindows_next_event() would not block. + * mswindows_next_event() would not block. */ static int -emacs_mswindows_event_pending_p (int how_many) +mswindows_event_pending_p (int how_many) { /* This can call Lisp */ if (!how_many) ＠＠ -4244,7 +4182,7 ＠＠ if (count >= how_many) return 1; - emacs_mswindows_drain_queue (); + mswindows_drain_queue (); EVENT_CHAIN_LOOP (event, dispatch_event_queue) count++; ＠＠ -4257,7 +4195,7 ＠＠ * Return the next event */ static void -emacs_mswindows_next_event (Lisp_Event *emacs_event) +mswindows_next_event (Lisp_Event *emacs_event) { Lisp_Object event, event2; ＠＠ -4270,7 +4208,7 ＠＠ } static void -emacs_mswindows_format_magic_event (Lisp_Event *emacs_event, +mswindows_format_magic_event (Lisp_Event *emacs_event, Lisp_Object pstream) { #define FROB(msg) case msg: write_c_string (pstream, "type=" #msg); break ＠＠ -4296,14 +4234,14 ＠＠ } static int -emacs_mswindows_compare_magic_event (Lisp_Event *e1, Lisp_Event *e2) +mswindows_compare_magic_event (Lisp_Event *e1, Lisp_Event *e2) { return (EVENT_MAGIC_MSWINDOWS_EVENT (e1) == EVENT_MAGIC_MSWINDOWS_EVENT (e2)); } static Hashcode -emacs_mswindows_hash_magic_event (Lisp_Event *e) +mswindows_hash_magic_event (Lisp_Event *e) { return (EVENT_MAGIC_MSWINDOWS_EVENT (e)); } ＠＠ -4312,7 +4250,7 ＠＠ * Handle a magic event off the dispatch queue. */ static void -emacs_mswindows_handle_magic_event (Lisp_Event *emacs_event) +mswindows_handle_magic_event (Lisp_Event *emacs_event) { switch (EVENT_MAGIC_MSWINDOWS_EVENT (emacs_event)) { ＠＠ -4401,7 +4339,7 ＠＠ #endif /* not CYGWIN */ static void -emacs_mswindows_select_process (Lisp_Process *process, int doin, int doerr) +mswindows_select_process (Lisp_Process *process, int doin, int doerr) { #ifdef CYGWIN int infd, errfd; ＠＠ -4460,7 +4398,7 ＠＠ } static void -emacs_mswindows_unselect_process (Lisp_Process *process, int doin, int doerr) +mswindows_unselect_process (Lisp_Process *process, int doin, int doerr) { #ifdef CYGWIN int infd, errfd; ＠＠ -4486,7 +4424,7 ＠＠ } static void -emacs_mswindows_select_console (struct console *USED_IF_CYGWIN (con)) +mswindows_select_console (struct console *USED_IF_CYGWIN (con)) { #ifdef CYGWIN if (CONSOLE_MSWINDOWS_P (con)) ＠＠ -4521,7 +4459,7 ＠＠ } static void -emacs_mswindows_unselect_console (struct console *USED_IF_CYGWIN (con)) +mswindows_unselect_console (struct console *USED_IF_CYGWIN (con)) { #ifdef CYGWIN if (CONSOLE_MSWINDOWS_P (con)) ＠＠ -4546,13 +4484,13 ＠＠ } static void -emacs_mswindows_create_io_streams (void *inhandle, void *outhandle, - void *errhandle, Lisp_Object *instream, - Lisp_Object *outstream, - Lisp_Object *errstream, - USID *in_usid, - USID *err_usid, - int flags) +mswindows_create_io_streams (void *inhandle, void *outhandle, + void *errhandle, Lisp_Object *instream, + Lisp_Object *outstream, + Lisp_Object *errstream, + USID *in_usid, + USID *err_usid, + int flags) { #ifdef CYGWIN event_stream_unixoid_create_io_streams (inhandle, outhandle, ＠＠ -4610,11 +4548,11 ＠＠ } static void -emacs_mswindows_delete_io_streams (Lisp_Object instream, - Lisp_Object USED_IF_CYGWIN (outstream), - Lisp_Object errstream, - USID *in_usid, - USID *err_usid) +mswindows_delete_io_streams (Lisp_Object instream, + Lisp_Object USED_IF_CYGWIN (outstream), + Lisp_Object errstream, + USID *in_usid, + USID *err_usid) { #ifdef CYGWIN event_stream_unixoid_delete_io_streams (instream, outstream, errstream, ＠＠ -4637,7 +4575,7 ＠＠ } static int -emacs_mswindows_current_event_timestamp (struct console *UNUSED (c)) +mswindows_current_event_timestamp (struct console *UNUSED (c)) { return GetTickCount (); } ＠＠ -5019,23 +4957,22 ＠＠ mswindows_event_stream = xnew_and_zero (struct event_stream); - mswindows_event_stream->event_pending_p = emacs_mswindows_event_pending_p; - mswindows_event_stream->next_event_cb = emacs_mswindows_next_event; - mswindows_event_stream->handle_magic_event_cb = emacs_mswindows_handle_magic_event; - mswindows_event_stream->format_magic_event_cb = emacs_mswindows_format_magic_event; - mswindows_event_stream->compare_magic_event_cb= emacs_mswindows_compare_magic_event; - mswindows_event_stream->hash_magic_event_cb = emacs_mswindows_hash_magic_event; - mswindows_event_stream->add_timeout_cb = emacs_mswindows_add_timeout; - mswindows_event_stream->remove_timeout_cb = emacs_mswindows_remove_timeout; - mswindows_event_stream->drain_queue_cb = emacs_mswindows_drain_queue; - mswindows_event_stream->select_console_cb = emacs_mswindows_select_console; - mswindows_event_stream->unselect_console_cb = emacs_mswindows_unselect_console; - mswindows_event_stream->select_process_cb = emacs_mswindows_select_process; - mswindows_event_stream->unselect_process_cb = emacs_mswindows_unselect_process; - mswindows_event_stream->create_io_streams_cb = emacs_mswindows_create_io_streams; - mswindows_event_stream->delete_io_streams_cb = emacs_mswindows_delete_io_streams; - mswindows_event_stream->current_event_timestamp_cb = - emacs_mswindows_current_event_timestamp; + EVENT_STREAM_HAS_METHOD (mswindows, event_pending_p); + EVENT_STREAM_HAS_METHOD (mswindows, next_event); + EVENT_STREAM_HAS_METHOD (mswindows, handle_magic_event); + EVENT_STREAM_HAS_METHOD (mswindows, format_magic_event); + EVENT_STREAM_HAS_METHOD (mswindows, compare_magic_event); + EVENT_STREAM_HAS_METHOD (mswindows, hash_magic_event); + EVENT_STREAM_HAS_METHOD (mswindows, add_timeout); + EVENT_STREAM_HAS_METHOD (mswindows, remove_timeout); + EVENT_STREAM_HAS_METHOD (mswindows, drain_queue); + EVENT_STREAM_HAS_METHOD (mswindows, select_console); + EVENT_STREAM_HAS_METHOD (mswindows, unselect_console); + EVENT_STREAM_HAS_METHOD (mswindows, select_process); + EVENT_STREAM_HAS_METHOD (mswindows, unselect_process); + EVENT_STREAM_HAS_METHOD (mswindows, create_io_streams); + EVENT_STREAM_HAS_METHOD (mswindows, delete_io_streams); + EVENT_STREAM_HAS_METHOD (mswindows, current_event_timestamp); dde_eval_pending = 0; } 1.87.4.1 +429 -320 XEmacs/xemacs/src/event-stream.c Index: event-stream.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/event-stream.c,v retrieving revision 1.87 retrieving revision 1.87.4.1 diff -u -r1.87 -r1.87.4.1 --- event-stream.c 2005/01/24 23:33:53 1.87 +++ event-stream.c 2005/02/16 00:43:03 1.87.4.1 ＠＠ -57,11 +57,6 ＠＠ trying to be "compatible" with pseudo-standards established by Emacs v18. - The command builder should deal only with key and button events. - Other command events should be able to come in the MIDDLE of a key - sequence, without disturbing the key sequence composition, or the - command builder structure representing it. - Someone should rethink universal-argument and figure out how an arbitrary command can influence the next command (universal-argument or universal-coding-system-argument) or the next key (hyperify). ＠＠ -155,6 +150,22 ＠＠ Lisp_Object Vcurrent_mouse_event; +/* Holds name of function of one argument (an event), to implement + all mouse-motion behavior. */ +Lisp_Object Vmouse_motion_handler; + +/* Holds name of function of one argument (an event), to implement + all scrollbar-event behavior. */ +Lisp_Object Vscrollbar_event_handler; + +/* Holds name of function of one argument (an event), to implement + all notify-event behavior. */ +Lisp_Object Vnotify_event_handler; + +/* Holds name of function of one argument (an event), to implement + all drop-event behavior. */ +Lisp_Object Vdrop_event_handler; + /* This is fbound in cmdloop.el, see the commentary there */ Lisp_Object Qcancel_mode_internal; ＠＠ -251,7 +262,7 ＠＠ Charcount num_input_chars; static Lisp_Object Qnext_event, Qdispatch_event, QSnext_event_internal; -static Lisp_Object QSexecute_internal_event; +static Lisp_Object QSexecute_non_user_event; #ifdef DEBUG_XEMACS Fixnum debug_emacs_events; ＠＠ -277,7 +288,6 ＠＠ /* The callback routines for the window system or terminal driver */ struct event_stream *event_stream; - /* See also ＠＠ -285,8 +295,8 ＠＠ (Info-goto-node "(internals)Event Stream Callback Routines") */ -static Lisp_Object command_event_queue; -static Lisp_Object command_event_queue_tail; +static Lisp_Object deferred_event_queue; +static Lisp_Object deferred_event_queue_tail; Lisp_Object dispatch_event_queue; static Lisp_Object dispatch_event_queue_tail; ＠＠ -316,14 +326,43 ＠＠ static void push_this_command_keys (Lisp_Object event); static void push_recent_keys (Lisp_Object event); static void dribble_out_event (Lisp_Object event); -static void execute_internal_event (Lisp_Object event); -static int is_scrollbar_event (Lisp_Object event); +static void execute_non_user_event (Lisp_Object event);  /**********************************************************************/ /* Command-builder object */ /**********************************************************************/ +/* + The command builder is used for keeping track of a partially built-up key + sequence (may include mouse clicks, activate events -- i.e. anything that + satisfies command_event_p()). The command builder also holds the + textual representation of the echoed keys, and some additional + information for handling translation using key-translation-map and + function-key-map. + + NOTE: + + The events in the command builder's list may not match those in the + echoed key string or in this-command-keys. In particular, C-u and + similar prefixes are full commands, and after them the command builder's + command gets reset, but the echoed keys and this-command-keys do not. + + Currently we treat all command events the same, except that the function + to look up and return the (possibly partial) binding always treats + activate events as terminating a command, and ignores the previous + (prefix) keys leading up to the event. + + Non-command user events (scrollbar, notify, drop) do not interact with + the command builder at all. The state of the command builder doesn't + change as they are dispatched, and so it should (theoretically) be + possible to type C-x, move the scrollbar, then C-f and open a file. + + The command builder is per-console, and is a Lisp object to facilitate + marking. + */ + + #define XCOMMAND_BUILDER(x) \ XRECORD (x, command_builder, struct command_builder) #define wrap_command_builder(p) wrap_record (p, command_builder) ＠＠ -499,42 +538,42 ＠＠ event_stream_handle_magic_event (Lisp_Event *event) { check_event_stream_ok (); - event_stream->handle_magic_event_cb (event); + event_stream->handle_magic_event (event); } void event_stream_format_magic_event (Lisp_Event *event, Lisp_Object pstream) { check_event_stream_ok (); - event_stream->format_magic_event_cb (event, pstream); + event_stream->format_magic_event (event, pstream); } int event_stream_compare_magic_event (Lisp_Event *e1, Lisp_Event *e2) { check_event_stream_ok (); - return event_stream->compare_magic_event_cb (e1, e2); + return event_stream->compare_magic_event (e1, e2); } Hashcode event_stream_hash_magic_event (Lisp_Event *e) { check_event_stream_ok (); - return event_stream->hash_magic_event_cb (e); + return event_stream->hash_magic_event (e); } static int event_stream_add_timeout (EMACS_TIME timeout) { check_event_stream_ok (); - return event_stream->add_timeout_cb (timeout); + return event_stream->add_timeout (timeout); } static void event_stream_remove_timeout (int id) { check_event_stream_ok (); - event_stream->remove_timeout_cb (id); + event_stream->remove_timeout (id); } void ＠＠ -543,7 +582,7 ＠＠ check_event_stream_ok (); if (!con->input_enabled) { - event_stream->select_console_cb (con); + event_stream->select_console (con); con->input_enabled = 1; } } ＠＠ -554,7 +593,7 ＠＠ check_event_stream_ok (); if (con->input_enabled) { - event_stream->unselect_console_cb (con); + event_stream->unselect_console (con); con->input_enabled = 0; } } ＠＠ -584,7 +623,7 ＠＠ if (doin || doerr) { - event_stream->select_process_cb (proc, doin, doerr); + event_stream->select_process (proc, doin, doerr); set_process_selected_p (proc, cur_in || doin, cur_err || doerr); } } ＠＠ -614,7 +653,7 ＠＠ if (doin || doerr) { - event_stream->unselect_process_cb (proc, doin, doerr); + event_stream->unselect_process (proc, doin, doerr); set_process_selected_p (proc, cur_in && !doin, cur_err && !doerr); } } ＠＠ -629,7 +668,7 ＠＠ int flags) { check_event_stream_ok (); - event_stream->create_io_streams_cb + event_stream->create_io_streams (inhandle, outhandle, errhandle, instream, outstream, errstream, in_usid, err_usid, flags); } ＠＠ -642,15 +681,15 ＠＠ USID *err_usid) { check_event_stream_ok (); - event_stream->delete_io_streams_cb (instream, outstream, errstream, + event_stream->delete_io_streams (instream, outstream, errstream, in_usid, err_usid); } -static int +int event_stream_current_event_timestamp (struct console *c) { - if (event_stream && event_stream->current_event_timestamp_cb) - return event_stream->current_event_timestamp_cb (c); + if (event_stream && event_stream->current_event_timestamp) + return event_stream->current_event_timestamp (c); else return 0; } ＠＠ -676,7 +715,7 ＠＠ clear_echo_area (selected_frame (), Qnil, 0); } - format_event_object (buf, event, 1); + format_event_object (buf, event, 0); len = eilen (buf); if (len + buf_index + 4 > command_builder->echo_buf_length) ＠＠ -1406,19 +1445,18 ＠＠ /**********************************************************************/ /* Add an event to the back of the command-event queue: it will be the next - event read after all pending events. This only works on keyboard, - mouse-click, misc-user, and eval events. + event read after all pending events. */ static void -enqueue_command_event (Lisp_Object event) +enqueue_deferred_event (Lisp_Object event) { - enqueue_event (event, &command_event_queue, &command_event_queue_tail); + enqueue_event (event, &deferred_event_queue, &deferred_event_queue_tail); } static Lisp_Object -dequeue_command_event (void) +dequeue_deferred_event (void) { - return dequeue_event (&command_event_queue, &command_event_queue_tail); + return dequeue_event (&deferred_event_queue, &deferred_event_queue_tail); } void ＠＠ -1434,9 +1472,9 ＠＠ } static void -enqueue_command_event_1 (Lisp_Object event_to_copy) +enqueue_deferred_event_1 (Lisp_Object event_to_copy) { - enqueue_command_event (Fcopy_event (event_to_copy, Qnil)); + enqueue_deferred_event (Fcopy_event (event_to_copy, Qnil)); } void ＠＠ -1447,7 +1485,7 ＠＠ /* channel for magic_eval events is nil */ XSET_EVENT_MAGIC_EVAL_INTERNAL_FUNCTION (event, fun); XSET_EVENT_MAGIC_EVAL_OBJECT (event, object); - enqueue_command_event (event); + enqueue_deferred_event (event); } DEFUN ("enqueue-eval-event", Fenqueue_eval_event, 2, 2, 0, /* ＠＠ -1465,47 +1503,108 ＠＠ /* channel for eval events is nil */ XSET_EVENT_EVAL_FUNCTION (event, function); XSET_EVENT_EVAL_OBJECT (event, object); - enqueue_command_event (event); + enqueue_deferred_event (event); return event; } -Lisp_Object -enqueue_misc_user_event (Lisp_Object channel, Lisp_Object function, - Lisp_Object object) +/* These functions stuff an event onto the internal dispatch queues + maintained by each window system. (#### The dispatch queues really need + to be abstracted out and made non-system-specific, since they all have + them. This would make QUIT processing be non-system-specific.) + + The reason for stuffing them onto the dispatch queue, rather than the + regular "command-event-queue", is that modern-day window systems are + generally set up so that you run a simple get-event/dispatch-event loop, + and the actual processing of events happens in callbacks; that way, you + don't have to do the dirty work of figuring out whether a particular + event is destined for you, for a control, etc. Often the only way of + getting controls to participate correctly requires passing all events + through the dispatch-event call rather than trying to filter out your + own. In some cases, events will only be received through callbacks. So + basically, the implementation of the Emacs "next-event" in all of the + different window systems involves keeping a separate "dispatch queue" + onto which callback routines can dump events, and running an internal + get-event/dispatch-event loop (a "modal loop") until an event shows up + on the dispatch queue. If we enqueue onto the command-event-queue, + we won't break out of the modal loop. */ + +void +enqueue_activate_event (enum activate_event_type type, + Lisp_Object channel, Lisp_Object name, + Lisp_Object callback) { Lisp_Object event = Fmake_event (Qnil, Qnil); - XSET_EVENT_TYPE (event, misc_user_event); - XSET_EVENT_CHANNEL (event, channel); - XSET_EVENT_MISC_USER_FUNCTION (event, function); - XSET_EVENT_MISC_USER_OBJECT (event, object); - XSET_EVENT_MISC_USER_BUTTON (event, 0); - XSET_EVENT_MISC_USER_MODIFIERS (event, 0); - XSET_EVENT_MISC_USER_X (event, -1); - XSET_EVENT_MISC_USER_Y (event, -1); - enqueue_command_event (event); + Lisp_Event *e = XEVENT (event); - return event; + e->event_type = activate_event; + e->channel = channel; + e->timestamp = current_time_from_event_channel_or_else (channel); + SET_EVENT_ACTIVATE_TYPE (e, type); + SET_EVENT_ACTIVATE_TEXT (e, name); + SET_EVENT_ACTIVATE_CALLBACK (e, callback); + + enqueue_dispatch_event (event); } -Lisp_Object -enqueue_misc_user_event_pos (Lisp_Object channel, Lisp_Object function, - Lisp_Object object, - int button, int modifiers, int x, int y) +/* + * Add a notify event to the dispatch queue. + */ +void +enqueue_notify_event (enum notify_event_type type, Lisp_Object frame) { Lisp_Object event = Fmake_event (Qnil, Qnil); + Lisp_Event *e = XEVENT (event); - XSET_EVENT_TYPE (event, misc_user_event); - XSET_EVENT_CHANNEL (event, channel); - XSET_EVENT_MISC_USER_FUNCTION (event, function); - XSET_EVENT_MISC_USER_OBJECT (event, object); - XSET_EVENT_MISC_USER_BUTTON (event, button); - XSET_EVENT_MISC_USER_MODIFIERS (event, modifiers); - XSET_EVENT_MISC_USER_X (event, x); - XSET_EVENT_MISC_USER_Y (event, y); - enqueue_command_event (event); + e->event_type = notify_event; + e->channel = frame; + e->timestamp = current_time_from_event_channel_or_else (frame); + SET_EVENT_NOTIFY_TYPE (e, type); - return event; + enqueue_dispatch_event (event); +} + +/* + * Add a scrollbar event to the dispatch queue. + */ +void +enqueue_scrollbar_event (enum scrollbar_event_type type, + Lisp_Object window, Lisp_Object value) +{ + Lisp_Object event = Fmake_event (Qnil, Qnil); + Lisp_Event *e = XEVENT (event); + + SET_EVENT_TYPE (e, scrollbar_event); + SET_EVENT_CHANNEL (e, window); + SET_EVENT_TIMESTAMP (e, current_time_from_event_channel_or_else (window)); + SET_EVENT_SCROLLBAR_TYPE (e, type); + SET_EVENT_SCROLLBAR_VALUE (e, value); + + enqueue_dispatch_event (event); +} + +/* + * Add a drop event to the dispatch queue. + */ +void +enqueue_drop_event (Lisp_Object channel, Lisp_Object data_type, + Lisp_Object data, int button, int modifiers, + int x, int y) +{ + Lisp_Object event = Fmake_event (Qnil, Qnil); + Lisp_Event *e = XEVENT (event); + + SET_EVENT_TYPE (e, drop_event); + SET_EVENT_CHANNEL (e, channel); + SET_EVENT_TIMESTAMP (e, current_time_from_event_channel_or_else (channel)); + SET_EVENT_DROP_DATA_TYPE (e, data_type); + SET_EVENT_DROP_DATA (e, data); + SET_EVENT_DROP_BUTTON (e, button); + SET_EVENT_DROP_MODIFIERS (e, modifiers); + SET_EVENT_DROP_X (e, x); + SET_EVENT_DROP_Y (e, y); + + enqueue_dispatch_event (event); }  ＠＠ -1772,16 +1871,16 ＠＠ static void event_stream_force_event_pending (struct frame *f) { - if (event_stream->force_event_pending_cb) - event_stream->force_event_pending_cb (f); + if (event_stream->force_event_pending) + event_stream->force_event_pending (f); } void event_stream_drain_queue (void) { /* This can call Lisp */ - if (event_stream && event_stream->drain_queue_cb) - event_stream->drain_queue_cb (); + if (event_stream && event_stream->drain_queue) + event_stream->drain_queue (); } /* Return non-zero if at least HOW_MANY user events are pending. */ ＠＠ -1799,7 +1898,7 ＠＠ if (how_many <= 0) return 1; - EVENT_CHAIN_LOOP (event, command_event_queue) + EVENT_CHAIN_LOOP (event, deferred_event_queue) { if (XEVENT_TYPE (event) != eval_event && XEVENT_TYPE (event) != magic_eval_event) ＠＠ -1972,7 +2071,7 ＠＠ Let's hope it doesn't. I think the code here is fairly clean and doesn't do this. */ emacs_is_blocking = 1; - event_stream->next_event_cb (event); + event_stream->next_event (event); emacs_is_blocking = 0; /* Now check to see if C-g was pressed while we were blocking. ＠＠ -2024,18 +2123,18 ＠＠ if (!focus_follows_mouse) investigate_frame_change (); - if (allow_queued && !NILP (command_event_queue)) + if (allow_queued && !NILP (deferred_event_queue)) { - Lisp_Object event = dequeue_command_event (); + Lisp_Object event = dequeue_deferred_event (); Fcopy_event (event, target_event); Fdeallocate_event (event); - DEBUG_PRINT_EMACS_EVENT ("command event queue", target_event); + DEBUG_PRINT_EMACS_EVENT ("deferred event queue", target_event); } else { Lisp_Event *e = XEVENT (target_event); - /* The command_event_queue was empty. Wait for an event. */ + /* The deferred_event_queue was empty. Wait for an event. */ event_stream_next_event (e); /* If this was a timeout, then we need to extract some data out of the returned closure and might need to resignal ＠＠ -2101,9 +2200,9 ＠＠ -- any events in `unread-command-events' or `unread-command-event'; else -- the next event in the currently executing keyboard macro, if any; else -- an event queued by `enqueue-eval-event', if any, or any similar event - queued internally, such as a misc-user event. (For example, when an item + queued internally, such as an activate event. (For example, when an item is selected from a menu or from a `question'-type dialog box, the item's - callback is not immediately executed, but instead a misc-user event + callback is not immediately executed, but instead an activate event is generated and placed onto this queue; when it is dispatched, the callback is executed.) Else -- the next available event from the window system or terminal driver. ＠＠ -2114,8 +2213,12 ＠＠ -- a key-press event. -- a button-press or button-release event. --- a misc-user-event, meaning the user selected an item on a menu or used - the scrollbar. +-- an activate event, meaning the user selected an item on a menu, toolbar + or dialog box, or activated a widget (click on button, etc.). +-- a scrollbar event. +-- a drop event -- something was dragged and dropped onto an XEmacs frame. +-- a notify event -- miscellaneous user actions (currently, closing the + frame using the close button or cancelling menus, dialog boxes, etc.). -- a process event, meaning that output from a subprocess is available. -- a timeout event, meaning that a timeout has elapsed. -- an eval event, which simply causes a function to be executed when the ＠＠ -2213,7 +2316,7 ＠＠ { Lisp_Object e = XCAR (Vunread_command_events); Vunread_command_events = XCDR (Vunread_command_events); - if (!EVENTP (e) || !command_event_p (e)) + if (!EVENTP (e) || !user_event_p (e)) signal_error_1 (Qwrong_type_argument, list3 (Qcommand_event_p, e, Qunread_command_events)); redisplay_no_pre_idle_hook (); ＠＠ -2229,7 +2332,7 ＠＠ Lisp_Object e = Vunread_command_event; Vunread_command_event = Qnil; - if (!EVENTP (e) || !command_event_p (e)) + if (!EVENTP (e) || !user_event_p (e)) { signal_error_1 (Qwrong_type_argument, list3 (Qeventp, e, Qunread_command_event)); ＠＠ -2255,7 +2358,7 ＠＠ DEBUG_PRINT_EMACS_EVENT ("keyboard macro", event); } /* Otherwise, read a real event, possibly from the - command_event_queue, and update this-command-keys and + deferred_event_queue, and update this-command-keys and recent-keys. */ else { ＠＠ -2290,13 +2393,19 ＠＠ switch (XEVENT_TYPE (event)) { + case scrollbar_event: + case drop_event: + case notify_event: + goto EXECUTE_EVENT; + case button_release_event: - case misc_user_event: + case activate_event: /* don't echo menu accelerator keys */ reset_key_echo (command_builder, 1); - goto EXECUTE_KEY; + goto EXECUTE_EVENT; + case button_press_event: /* key or mouse input can trigger prompting */ - goto STORE_AND_EXECUTE_KEY; + goto STORE_AND_EXECUTE_EVENT; case key_press_event: /* any key input can trigger autosave */ break; default: ＠＠ -2310,18 +2419,18 ＠＠ depth = begin_dont_check_for_quit (); num_input_chars++; - STORE_AND_EXECUTE_KEY: + STORE_AND_EXECUTE_EVENT: if (store_this_key) { echo_key_event (command_builder, event); } - EXECUTE_KEY: + EXECUTE_EVENT: /* Store the last-input-event. The semantics of this is that it is the thing most recently returned by next-command-event. It need not have come from the keyboard or a keyboard macro, it may have - come from unread-command-events. It's always a command-event (a - key, click, or menu selection), never a motion or process event. + come from unread-command-events. It's always a user event, never + a motion or process event. */ if (!EVENTP (Vlast_input_event)) Vlast_input_event = Fmake_event (Qnil, Qnil); ＠＠ -2362,8 +2471,7 ＠＠ */ if (store_this_key) { - if (!is_scrollbar_event (event)) /* #### not quite right, see - comment in execute_command_event */ + if (command_event_p (event)) push_this_command_keys (event); if (!inhibit_input_event_recording) push_recent_keys (event); ＠＠ -2416,10 +2524,7 ＠＠ (while (progn (next-event event prompt) - (not (or (key-press-event-p event) - (button-press-event-p event) - (button-release-event-p event) - (misc-user-event-p event)))) + (not (user-event-p event))) (dispatch-event event)) but it also makes a provision for displaying keystrokes in the echo area. ＠＠ -2437,10 +2542,10 ＠＠ for (;;) { event = Fnext_event (event, prompt); - if (command_event_p (event)) + if (user_event_p (event)) break; else - execute_internal_event (event); + execute_non_user_event (event); } UNGCPRO; return event; ＠＠ -2470,9 +2575,9 ＠＠ while (event_stream_event_pending_p (0)) { - /* We're a generator of the command_event_queue, so we can't be a + /* We're a generator of the deferred_event_queue, so we can't be a consumer as well. Also, we have no reason to consult the - command_event_queue; there are only user and eval-events there, + deferred_event_queue; there are only user and eval-events there, and we'd just have to put them back anyway. */ next_event_internal (event, 0); /* blocks */ ＠＠ -2480,10 +2585,10 ＠＠ XEVENT_TYPE (event) == timeout_event || XEVENT_TYPE (event) == process_event || XEVENT_TYPE (event) == pointer_motion_event) - execute_internal_event (event); + execute_non_user_event (event); else { - enqueue_command_event_1 (event); + enqueue_deferred_event_1 (event); break; } } ＠＠ -2503,16 +2608,15 ＠＠ } static int -command_event_p_cb (Lisp_Object ev, void *UNUSED (the_data)) +user_event_p_cb (Lisp_Object ev, void *UNUSED (the_data)) { - return command_event_p (ev); + return user_event_p (ev); } DEFUN ("discard-input", Fdiscard_input, 0, 0, 0, /* Discard any pending "user" events. Also cancel any kbd macro being defined. -A user event is a key press, button press, button release, or -"misc-user" event (menu selection or scrollbar action). +A user event is any event that satisfies `user-event-p'. */ ()) { ＠＠ -2536,11 +2640,11 ＠＠ command and dispatch queues. */ event_stream_drain_queue (); - map_event_chain_remove (command_event_p_cb, + map_event_chain_remove (user_event_p_cb, &dispatch_event_queue, &dispatch_event_queue_tail, 0, MECR_DEALLOCATE_EVENT); - map_event_chain_remove (command_event_p_cb, - &command_event_queue, &command_event_queue_tail, + map_event_chain_remove (user_event_p_cb, + &deferred_event_queue, &deferred_event_queue_tail, 0, MECR_DEALLOCATE_EVENT); return Qnil; ＠＠ -2643,8 +2747,8 ＠＠ (NILP (process) && event_stream_event_pending_p (0)) || (!NILP (process)))) /* Calling detect_input_pending() is the wrong thing here, because - that considers the Vunread_command_events and command_event_queue. - We don't need to look at the command_event_queue because we are + that considers the Vunread_command_events and deferred_event_queue. + We don't need to look at the deferred_event_queue because we are only interested in process events, which don't go on that. In fact, we can't read from it anyway, because we put stuff on it. ＠＠ -2679,7 +2783,7 ＠＠ result = Qt; } - execute_internal_event (event); + execute_non_user_event (event); break; } case timeout_event: ＠＠ -2688,12 +2792,12 ＠＠ case pointer_motion_event: case magic_event: { - execute_internal_event (event); + execute_non_user_event (event); break; } default: { - enqueue_command_event_1 (event); + enqueue_deferred_event_1 (event); break; } } ＠＠ -2741,7 +2845,7 ＠＠ if (!event_stream_wakeup_pending_p (id, 0)) goto DONE_LABEL; - /* We're a generator of the command_event_queue, so we can't be a + /* We're a generator of the deferred_event_queue, so we can't be a consumer as well. We don't care about command and eval-events anyway. */ ＠＠ -2755,12 +2859,12 ＠＠ case pointer_motion_event: case magic_event: { - execute_internal_event (event); + execute_non_user_event (event); break; } default: { - enqueue_command_event_1 (event); + enqueue_deferred_event_1 (event); break; } } ＠＠ -2799,11 +2903,11 ＠＠ /* If the command-builder already has user-input on it (not eval events) then that means we're done too. */ - if (!NILP (command_event_queue)) + if (!NILP (deferred_event_queue)) { - EVENT_CHAIN_LOOP (event, command_event_queue) + EVENT_CHAIN_LOOP (event, deferred_event_queue) { - if (command_event_p (event)) + if (user_event_p (event)) return Qnil; } } ＠＠ -2855,13 +2959,13 ＠＠ goto DONE_LABEL; } - /* We're a generator of the command_event_queue, so we can't be a + /* We're a generator of the deferred_event_queue, so we can't be a consumer as well. In fact, we know there's nothing on the - command_event_queue that we didn't just put there. + deferred_event_queue that we didn't just put there. */ next_event_internal (event, 0); /* blocks */ - if (command_event_p (event)) + if (user_event_p (event)) { result = Qnil; goto DONE_LABEL; ＠＠ -2871,7 +2975,7 ＠＠ case eval_event: { /* eval-events get delayed until later. */ - enqueue_command_event (Fcopy_event (event, Qnil)); + enqueue_deferred_event (Fcopy_event (event, Qnil)); break; } ＠＠ -2880,7 +2984,7 ＠＠ happened above. */ default: { - execute_internal_event (event); + execute_non_user_event (event); break; } } ＠＠ -2897,7 +3001,7 ＠＠ point at all. */ if (NILP (result)) - enqueue_command_event (event); + enqueue_deferred_event (event); else Fdeallocate_event (event); ＠＠ -2917,18 +3021,18 ＠＠ while (!(*predicate) (predicate_arg)) { - /* We're a generator of the command_event_queue, so we can't be a + /* We're a generator of the deferred_event_queue, so we can't be a consumer as well. Also, we have no reason to consult the - command_event_queue; there are only user and eval-events there, + deferred_event_queue; there are only user and eval-events there, and we'd just have to put them back anyway. */ next_event_internal (event, 0); - if (command_event_p (event) + if (user_event_p (event) || (XEVENT_TYPE (event) == eval_event) || (XEVENT_TYPE (event) == magic_eval_event)) - enqueue_command_event_1 (event); + enqueue_deferred_event_1 (event); else - execute_internal_event (event); + execute_non_user_event (event); } UNGCPRO; } ＠＠ -2939,7 +3043,7 ＠＠ /**********************************************************************/ static void -execute_internal_event (Lisp_Object event) +execute_non_user_event (Lisp_Object event) { PROFILE_DECLARE (); ＠＠ -2947,7 +3051,7 ＠＠ if (object_dead_p (XEVENT (event)->channel)) return; - PROFILE_RECORD_ENTERING_SECTION (QSexecute_internal_event); + PROFILE_RECORD_ENTERING_SECTION (QSexecute_non_user_event); /* This function can GC */ switch (XEVENT_TYPE (event)) ＠＠ -3053,7 +3157,7 ＠＠ } /* We must call status_notify here to allow the - event_stream->unselect_process_cb to be run if appropriate. + event_stream->unselect_process to be run if appropriate. Otherwise, dead fds may be selected for, and we will get a continuous stream of process events for them. Since we don't return until all process events have been flushed, we would ＠＠ -3085,7 +3189,7 ＠＠ } done: - PROFILE_RECORD_EXITING_SECTION (QSexecute_internal_event); + PROFILE_RECORD_EXITING_SECTION (QSexecute_non_user_event); } ＠＠ -3295,21 +3399,13 ＠＠ static Lisp_Object command_builder_find_leaf_no_mule_processing (struct command_builder *builder, - int allow_misc_user_events_p, int *did_munge) { /* This function can GC */ - Lisp_Object result; + Lisp_Object result = Qunbound; Lisp_Object evee = builder->current_events; - if (XEVENT_TYPE (evee) == misc_user_event) - { - if (allow_misc_user_events_p && (NILP (XEVENT_NEXT (evee)))) - return list2 (XEVENT_EVAL_FUNCTION (evee), - XEVENT_EVAL_OBJECT (evee)); - else - return Qnil; - } + assert (command_event_p (evee)); /* if we're currently in a menu accelerator, check there for further events */ ＠＠ -3356,6 +3452,24 ＠＠ /* If key-sequence wasn't bound, we'll try some fallbacks. */ + /* The reason we check the callback all the way down here is so that if a + keymap has a default value, it will process the activate event; this + is necessary for C-u + menu-event to work properly since C-u expects + the next event, if unknown, to trigger universal-argument-other-key, + which turns off the C-u interception. If we don't do this, the next + command does it and gets eaten (#### Why?). */ + if (XEVENT_TYPE (evee) == activate_event) + { + result = XEVENT_ACTIVATE_CALLBACK (evee); + if (NILP (Fcommandp (result))) + /* simulate a command */ + result = list4 (Qlambda, Qnil, list1 (Qinteractive), result); + if (NILP (XEVENT_NEXT (evee))) + return result; + else /* #### How can this happen? */ + return Qnil; + } + /* If we didn't find a binding, and the last event in the sequence is a shifted character, then try again with the lowercase version. */ ＠＠ -3371,8 +3485,7 ＠＠ GCPRO1 (neubauten); downshift_event (event_chain_tail (neub->current_events)); result = - command_builder_find_leaf_no_mule_processing - (neub, allow_misc_user_events_p, did_munge); + command_builder_find_leaf_no_mule_processing (neub, did_munge); if (!NILP (result)) { ＠＠ -3396,12 +3509,9 ＠＠ /* Compare the current state of the command builder against the local and global keymaps, and return the binding. If there is no match, try again, - case-insensitively. The return value will be one of: - -- nil (there is no binding) - -- a keymap (part of a command has been specified) - -- a command (anything that satisfies `commandp'; this includes - some symbols, lists, subrs, strings, vectors, and - compiled-function objects) + case-insensitively. The return value is as in lookup_command_event(), + except that we should never see non-command events (i.e. notify, drop, + scrollbar). This may "munge" the current event chain in the command builder; i.e. the sequence might be mutated into a different sequence, ＠＠ -3420,12 +3530,10 ＠＠ static Lisp_Object command_builder_find_leaf (struct command_builder *builder, - int allow_misc_user_events_p, int *did_munge) { Lisp_Object result = - command_builder_find_leaf_no_mule_processing - (builder, allow_misc_user_events_p, did_munge); + command_builder_find_leaf_no_mule_processing (builder, did_munge); if (!NILP (result)) return result; ＠＠ -3451,14 +3559,11 ＠＠ static Lisp_Object command_builder_find_leaf_and_update_global_state (struct command_builder * - builder, - int - allow_misc_user_events_p) + builder) { int did_munge = 0; int orig_length = event_chain_count (builder->current_events); Lisp_Object result = command_builder_find_leaf (builder, - allow_misc_user_events_p, &did_munge); if (did_munge) ＠＠ -3495,8 +3600,8 ＠＠ /* Put the commands back on the event queue. */ enqueue_event_chain (XEVENT_NEXT (event0), - &command_event_queue, - &command_event_queue_tail); + &deferred_event_queue, + &deferred_event_queue_tail); /* Then remove them from the command builder. */ XSET_EVENT_NEXT (event0, Qnil); ＠＠ -3728,10 +3833,8 ＠＠ EVENT_CHAIN_LOOP (event, Vthis_command_keys) { - if (EVENTP (event) - && (XEVENT_TYPE (event) == button_press_event - || XEVENT_TYPE (event) == button_release_event - || XEVENT_TYPE (event) == misc_user_event)) + if (EVENTP (event) && command_event_p (event) && + XEVENT_TYPE (event) != key_press_event) { if (!n) { ＠＠ -3757,19 +3860,13 ＠＠ for (i = 0; i < len; i++) { Lisp_Object event = XVECTOR_DATA (vector)[i]; - if (EVENTP (event)) - switch (XEVENT_TYPE (event)) - { - case button_press_event : - case button_release_event : - case misc_user_event : - if (n == 0) - return event; - n--; - break; - default: - continue; - } + if (EVENTP (event) && command_event_p (event) && + XEVENT_TYPE (event) != key_press_event) + { + if (n == 0) + return event; + n--; + } } return Qnil; ＠＠ -3830,14 +3927,19 ＠＠ */ static Lisp_Object lookup_command_event (struct command_builder *command_builder, - Lisp_Object event, int allow_misc_user_events_p) + Lisp_Object event) { /* This function can GC */ struct frame *f = selected_frame (); + + /* Non-command events do not enter into command-building at all + and should be handled by callers. */ + assert (command_event_p (event)); + /* Clear output from previous command execution */ if (!EQ (Qcommand, echo_area_status (f)) /* but don't let mouse-up clear what mouse-down just printed */ - && (XEVENT (event)->event_type != button_release_event)) + && (XEVENT_TYPE (event) != button_release_event)) clear_echo_area (f, Qnil, 0); /* Add the given event to the command builder. ＠＠ -3867,8 +3969,6 ＠＠ || EVENT_TYPE (e) == button_release_event) SET_EVENT_BUTTON_MODIFIERS (e, EVENT_BUTTON_MODIFIERS (e) | XEMACS_MOD_META); - else - ABORT (); { int tckn = event_chain_count (Vthis_command_keys); ＠＠ -3887,9 +3987,7 ＠＠ { Lisp_Object leaf = - command_builder_find_leaf_and_update_global_state - (command_builder, - allow_misc_user_events_p); + command_builder_find_leaf_and_update_global_state (command_builder); struct gcpro gcpro1; GCPRO1 (leaf); ＠＠ -3926,7 +4024,7 ＠＠ /* if quit happened during menu acceleration, pretend we read it */ struct console *con = XCONSOLE (Fselected_console ()); - enqueue_command_event (Fcopy_event (CONSOLE_QUIT_EVENT (con), + enqueue_deferred_event (Fcopy_event (CONSOLE_QUIT_EVENT (con), Qnil)); Vquit_flag = Qnil; } ＠＠ -3949,38 +4047,9 ＠＠ } } -static int -is_scrollbar_event (Lisp_Object event) -{ -#ifdef HAVE_SCROLLBARS - Lisp_Object fun; - - if (XEVENT_TYPE (event) != misc_user_event) - return 0; - fun = XEVENT_MISC_USER_FUNCTION (event); - - return (EQ (fun, Qscrollbar_line_up) || - EQ (fun, Qscrollbar_line_down) || - EQ (fun, Qscrollbar_page_up) || - EQ (fun, Qscrollbar_page_down) || - EQ (fun, Qscrollbar_to_top) || - EQ (fun, Qscrollbar_to_bottom) || - EQ (fun, Qscrollbar_vertical_drag) || - EQ (fun, Qscrollbar_char_left) || - EQ (fun, Qscrollbar_char_right) || - EQ (fun, Qscrollbar_page_left) || - EQ (fun, Qscrollbar_page_right) || - EQ (fun, Qscrollbar_to_left) || - EQ (fun, Qscrollbar_to_right) || - EQ (fun, Qscrollbar_horizontal_drag)); -#else - return 0; -#endif /* HAVE_SCROLLBARS */ -} - static void -execute_command_event (struct command_builder *command_builder, - Lisp_Object event) +execute_user_event (struct command_builder *command_builder, + Lisp_Object event) { /* This function can GC */ struct console *con = XCONSOLE (command_builder->console); ＠＠ -3988,28 +4057,18 ＠＠ GCPRO1 (event); /* event may be freshly created */ - /* #### This call to is_scrollbar_event() isn't quite right, but - fixing properly it requires more work than can go into 21.4. - (We really need to split out menu, scrollbar, dialog, and other - types of events from misc-user, and put the remaining ones in a - new `user-eval' type that behaves like an eval event but is a - user event and thus has all of its semantics -- e.g. being - delayed during `accept-process-output' and similar wait states.) - - The real issue here is that "user events" and "command events" - are not the same thing, but are very much confused in - event-stream.c. User events are, essentially, any event that - should be delayed by accept-process-output, should terminate a - sit-for, etc. -- basically, any event that needs to be processed - synchronously with key and mouse events. Command events are - those that participate in command building; scrollbar events - clearly don't belong because they should be transparent in a - sequence like C-x ＠ h <scrollbar-drag> x, which used to cause a - crash before checks similar to the is_scrollbar_event() call were - added. Do other events belong with scrollbar events? I'm not - sure; we need to categorize all misc-user events and see what - their semantics are. + /* This call to command_event_p(): + "user events" and "command events" are not the same thing, but are + sometimes confused in event-stream.c. User events are, essentially, + any event that should be delayed by accept-process-output, should + terminate a sit-for, etc. -- basically, any event that needs to be + processed synchronously with key and mouse events. Command events are + those that participate in command building; scrollbar events clearly + don't belong because they should be transparent in a sequence like C-x + ＠ h <scrollbar-drag> x, which used to cause a crash before checks + similar to the command_event_p() call were added. + (You might ask, why do scrollbar events need to be user events? That's a good question. The answer seems to be that they can change point, and having this happen asynchronously would be a ＠＠ -4025,30 +4084,19 ＠＠ #### here, and later as a result of reset_this_command_keys(). #### This is almost certainly wrong; need to figure out what's #### correct. - - #### We need to figure out what's really correct w.r.t. scrollbar - #### events. With these new fixes in, it actually works to do - #### C-x <scrollbar-drag> 5 2, but the key echo gets messed up - #### (starts over at 5). We really need to be special-casing - #### scrollbar events at a lower level, and not really passing - #### them through the command builder at all. (e.g. do scrollbar - #### events belong in macros??? doubtful; probably only the - #### point movement, if any, belongs, special-cased as a - #### pseudo-issued M-x goto-char command). #### Need more work - #### here. Do this when separating out scrollbar events. */ - if (!is_scrollbar_event (event)) + if (command_event_p (event)) reset_current_events (command_builder); - switch (XEVENT (event)->event_type) + switch (XEVENT_TYPE (event)) { case key_press_event: Vcurrent_mouse_event = Qnil; break; case button_press_event: case button_release_event: - case misc_user_event: + case activate_event: Vcurrent_mouse_event = Fcopy_event (event, Qnil); break; default: break; ＠＠ -4058,7 +4106,7 ＠＠ is the last event most recently involved in command-lookup. */ if (!EVENTP (Vlast_command_event)) Vlast_command_event = Fmake_event (Qnil, Qnil); - if (XEVENT (Vlast_command_event)->event_type == dead_event) + if (XEVENT_TYPE (Vlast_command_event) == dead_event) { Vlast_command_event = Fmake_event (Qnil, Qnil); invalid_state ("Someone deallocated the last-command-event!", Qunbound); ＠＠ -4094,14 +4142,43 ＠＠ pre_command_hook (); - if (XEVENT_TYPE (event) == misc_user_event) + switch (XEVENT_TYPE (event)) { - call1 (XEVENT_MISC_USER_FUNCTION (event), - XEVENT_MISC_USER_OBJECT (event)); - } - else - { + case activate_event: + { + Lisp_Object callback = XEVENT_ACTIVATE_CALLBACK (event); + + if (EQ (callback, Qquit)) + { + /* #### This is way wrong; Need to handle QUIT much more + asynchronously */ + Vquit_flag = Qt; + QUIT; + } + else + Fcommand_execute (Vthis_command, Qnil, Qnil); + break; + } + + case scrollbar_event: + if (!NILP (Vscrollbar_event_handler)) + call1 (Vscrollbar_event_handler, event); + break; + + case drop_event: + if (!NILP (Vdrop_event_handler)) + call1 (Vdrop_event_handler, event); + break; + + case notify_event: + if (!NILP (Vnotify_event_handler)) + call1 (Vnotify_event_handler, event); + break; + + + default: Fcommand_execute (Vthis_command, Qnil, Qnil); + break; } post_command_hook (); ＠＠ -4135,7 +4212,7 ＠＠ /* Emacs 18 doesn't unconditionally clear the echoed keystrokes, so we don't either */ - if (!is_scrollbar_event (event)) + if (command_event_p (event)) reset_this_command_keys (CONSOLE_LIVE_P (con) ? wrap_console (con) : Qnil, 0); } ＠＠ -4235,9 +4312,16 ＠＠ under which you should change this handler. Use `mode-motion-hook' instead.) -Menu, timeout, and eval events cause the associated function or handler -to be called. +Activate, timeout, and eval events cause the associated function or +callback to be called. +Notify, scrollbar, and drop events cause the low-level handling function +stored in `notify-event-handler', `scrollbar-event-handler', and +`drop-event-handler', respectively, to be called. If you want to change +how these events are handled, you can create your own handler and store it +in the appropriate variable. As a general rule, you should call the +previous handler when you're done processing the event. + Process events cause the subprocess's output to be read and acted upon appropriately (see `start-process'). ＠＠ -4263,20 +4347,39 ＠＠ PROFILE_RECORD_ENTERING_SECTION (Qdispatch_event); /* Some events don't have channels (e.g. eval events). */ - console = CDFW_CONSOLE (channel); + console = Fcdfw_console (channel); if (NILP (console)) console = Vselected_console; else if (!EQ (console, Vselected_console)) Fselect_console (console); command_builder = XCOMMAND_BUILDER (XCONSOLE (console)->command_builder); + switch (XEVENT_TYPE (event)) { + default: + execute_non_user_event (event); + break; + + case scrollbar_event: + case drop_event: + case notify_event: + /* non-command events; just execute them. no fiddling around. */ + if (XEVENT_TYPE (event) == scrollbar_event) + /* Certain code expects to see the scrollbar function in + this-command */ + Vthis_command = Fevent_property (event, Qsubtype); + else + Vthis_command = Qnil; + execute_user_event (command_builder, event); + break; + + case activate_event: case button_press_event: case button_release_event: case key_press_event: { - Lisp_Object leaf = lookup_command_event (command_builder, event, 1); + Lisp_Object leaf = lookup_command_event (command_builder, event); if (KEYMAPP (leaf)) /* Incomplete key sequence */ ＠＠ -4313,7 +4416,7 ＠＠ /* If the "up" version is bound, don't complain. */ no_bitching = !NILP (command_builder_find_leaf_and_update_global_state - (command_builder, 0)); + (command_builder)); /* Undo the temporary changes we just made. */ XEVENT_TYPE (terminal) = button_press_event; if (no_bitching) ＠＠ -4370,6 +4473,12 ＠＠ Vthis_command = leaf; +#if 0 + /* #### I don't think this is correct --ben */ + if (XEVENT_TYPE (event) == activate_event) + /* clear the echo area */ + reset_key_echo (command_builder, 1); +#endif /* Don't push an undo boundary if the command set the prefix arg, or if we are executing a keyboard macro, or if in the minibuffer. If the command we are about to execute is ＠＠ -4397,7 +4506,13 ＠＠ command_builder->self_insert_countdown = 0; if (NILP (XCONSOLE (console)->prefix_arg) && NILP (Vexecuting_macro) - && command_builder->self_insert_countdown == 0) + && command_builder->self_insert_countdown == 0 + /* #### this is way screwy. i'm combining what was formerly + two similar paths in the code, and only the non-key/button + path had the minibuffer check. i imagine it should always + be there. --ben */ + && (XEVENT_TYPE (event) != activate_event || + !EQ (minibuf_window, Fselected_window (Qnil)))) Fundo_boundary (); if (magic_undo) ＠＠ -4405,7 +4520,7 ＠＠ if (--command_builder->self_insert_countdown < 0) command_builder->self_insert_countdown = magic_undo_count; } - execute_command_event + execute_user_event (command_builder, internal_equal (event, command_builder->most_current_event, 0) ? event ＠＠ -4417,48 +4532,6 ＠＠ } break; } - case misc_user_event: - { - /* Jamie said: - - We could just always use the menu item entry, whatever it is, but - this might break some Lisp code that expects `this-command' to - always contain a symbol. So only store it if this is a simple - `call-interactively' sort of menu item. - - But this is bogus. `this-command' could be a string or vector - anyway (for keyboard macros). There's even one instance - (in pending-del.el) of `this-command' getting set to a cons - (a lambda expression). So in the `eval' case I'll just - convert it into a lambda expression. - */ - if (EQ (XEVENT_MISC_USER_FUNCTION (event), Qcall_interactively) - && SYMBOLP (XEVENT_MISC_USER_OBJECT (event))) - Vthis_command = XEVENT_MISC_USER_OBJECT (event); - else if (EQ (XEVENT_MISC_USER_FUNCTION (event), Qeval)) - Vthis_command = - Fcons (Qlambda, Fcons (Qnil, XEVENT_MISC_USER_OBJECT (event))); - else if (SYMBOLP (XEVENT_MISC_USER_FUNCTION (event))) - /* A scrollbar command or the like. */ - Vthis_command = XEVENT_MISC_USER_FUNCTION (event); - else - /* Huh? */ - Vthis_command = Qnil; - - /* clear the echo area */ - reset_key_echo (command_builder, 1); - - command_builder->self_insert_countdown = 0; - if (NILP (XCONSOLE (console)->prefix_arg) - && NILP (Vexecuting_macro) - && !EQ (minibuf_window, Fselected_window (Qnil))) - Fundo_boundary (); - execute_command_event (command_builder, event); - break; - } - default: - execute_internal_event (event); - break; } PROFILE_RECORD_EXITING_SECTION (Qdispatch_event); ＠＠ -4530,13 +4603,18 ＠＠ /* restore the selected-console damage */ con = event_console_or_selected (event); command_builder = XCOMMAND_BUILDER (con->command_builder); - if (! command_event_p (event)) - execute_internal_event (event); + if (!user_event_p (event)) + execute_non_user_event (event); + else if (!command_event_p (event)) + execute_user_event (command_builder, event); else { - if (XEVENT_TYPE (event) == misc_user_event) +#if 0 + /* #### This looks wrong --ben */ + if (XEVENT_TYPE (event) == activate_event) reset_current_events (command_builder); - result = lookup_command_event (command_builder, event, 1); +#endif + result = lookup_command_event (command_builder, event); if (!KEYMAPP (result)) { result = current_events_into_vector (command_builder); ＠＠ -4768,10 +4846,10 ＠＠ Vthis_command_keys_tail = Qnil; dump_add_root_lisp_object (&Vthis_command_keys_tail); - command_event_queue = Qnil; - staticpro (&command_event_queue); - command_event_queue_tail = Qnil; - dump_add_root_lisp_object (&command_event_queue_tail); + deferred_event_queue = Qnil; + staticpro (&deferred_event_queue); + deferred_event_queue_tail = Qnil; + dump_add_root_lisp_object (&deferred_event_queue_tail); dispatch_event_queue = Qnil; staticpro (&dispatch_event_queue); ＠＠ -4792,8 +4870,8 ＠＠ QSnext_event_internal = build_string ("next_event_internal()"); staticpro (&QSnext_event_internal); - QSexecute_internal_event = build_string ("execute_internal_event()"); - staticpro (&QSexecute_internal_event); + QSexecute_non_user_event = build_string ("execute_non_user_event()"); + staticpro (&QSexecute_non_user_event); DEFVAR_LISP ("echo-keystrokes", &Vecho_keystrokes /* *Nonzero means echo unfinished commands after this many seconds of pause. ＠＠ -4840,6 +4918,37 ＠＠ */ ); focus_follows_mouse = 0; + DEFVAR_LISP ("mouse-motion-handler", &Vmouse_motion_handler /* +Holds a function of one arg (the event) that handles motion events. +Normally, the value of this is `default-mouse-motion-handler', and it +implements all of the standard behavior that happens as a result of a mouse +move (setting the various pointer-shape variables, extent highlighting, +help-echo, toolbar up/down, `mode-motion-hook'). This is the low-level +interface onto mouse handling, and the value of this variable is called +directly from C when a motion event is processed. + +For most applications, you should use `mode-motion-hook' instead of this. +*/ ); + Vmouse_motion_handler = Qnil; + + DEFVAR_LISP ("scrollbar-event-handler", &Vscrollbar_event_handler /* +Holds a function of one arg (the event) that handles scrollbar events. +Normally, the value of this is `default-scrollbar-event-handler'. +*/ ); + Vscrollbar_event_handler = Qnil; + + DEFVAR_LISP ("notify-event-handler", &Vnotify_event_handler /* +Holds a function of one arg (the event) that handles notify events. +Normally, the value of this is `default-notify-event-handler'. +*/ ); + Vnotify_event_handler = Qnil; + + DEFVAR_LISP ("drop-event-handler", &Vdrop_event_handler /* +Holds a function of one arg (the event) that handles drop events. +Normally, the value of this is `default-drop-event-handler'. +*/ ); + Vdrop_event_handler = Qnil; + DEFVAR_LISP ("last-command-event", &Vlast_command_event /* Last keyboard or mouse button event that was part of a command. This variable is off limits: you may not set its value or modify the event that ＠＠ -5068,7 +5177,7 ＠＠ \(unread-command-event) An event taken from `unread-command-event'. -\(command event queue) An event taken from an internal queue. +\(deferred event queue) An event taken from an internal queue. Events end up on this queue when `enqueue-eval-event' is called or when user or eval events are received while ＠＠ -5096,7 +5205,7 ＠＠ inhibit_input_event_recording = 0; Vkeyboard_translate_table = - make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (100, hash_table_non_weak, HASH_TABLE_EQ); } void 1.16.6.1 +44 -34 XEmacs/xemacs/src/event-tty.c Index: event-tty.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/event-tty.c,v retrieving revision 1.16 retrieving revision 1.16.6.1 diff -u -r1.16 -r1.16.6.1 --- event-tty.c 2004/11/04 23:06:27 1.16 +++ event-tty.c 2005/02/16 00:43:06 1.16.6.1 ＠＠ -41,6 +41,8 ＠＠ static struct event_stream *tty_event_stream; +static int tty_current_event_timestamp (struct console *c); + #ifdef WIN32_ANY extern int mswindows_is_blocking; #endif ＠＠ -56,13 +58,13 ＠＠ static struct low_level_timeout *tty_timer_queue; static int -emacs_tty_add_timeout (EMACS_TIME thyme) +tty_add_timeout (EMACS_TIME thyme) { return add_low_level_timeout (&tty_timer_queue, thyme); } static void -emacs_tty_remove_timeout (int id) +tty_remove_timeout (int id) { remove_low_level_timeout (&tty_timer_queue, id); } ＠＠ -72,7 +74,7 ＠＠ { /* timeout events have nil as channel */ SET_EVENT_TYPE (emacs_event, timeout_event); - SET_EVENT_TIMESTAMP_ZERO (emacs_event); /* #### */ + SET_EVENT_TIMESTAMP (emacs_event, tty_current_event_timestamp (0)); SET_EVENT_TIMEOUT_INTERVAL_ID (emacs_event, pop_low_level_timeout (&tty_timer_queue, 0)); SET_EVENT_TIMEOUT_FUNCTION (emacs_event, Qnil); ＠＠ -82,7 +84,7 ＠＠  static int -emacs_tty_event_pending_p (int how_many) +tty_event_pending_p (int how_many) { if (!how_many) { ＠＠ -103,7 +105,7 ＠＠ } static void -emacs_tty_next_event (Lisp_Event *emacs_event) +tty_next_event (Lisp_Event *emacs_event) { while (1) { ＠＠ -159,7 +161,8 ＠＠ process = wrap_process (p); set_event_type (emacs_event, process_event); /* process events have nil as channel */ - SET_EVENT_TIMESTAMP_ZERO (emacs_event); /* #### */ + SET_EVENT_TIMESTAMP (emacs_event, + tty_current_event_timestamp (0)); SET_EVENT_PROCESS_PROCESS (emacs_event, process); return; } ＠＠ -184,34 +187,34 ＠＠ } static void -emacs_tty_format_magic_event (Lisp_Event *UNUSED (emacs_event), - Lisp_Object UNUSED (pstream)) +tty_format_magic_event (Lisp_Event *UNUSED (emacs_event), + Lisp_Object UNUSED (pstream)) { /* Nothing to do currently */ } static int -emacs_tty_compare_magic_event (Lisp_Event *UNUSED (e1), - Lisp_Event *UNUSED (e2)) +tty_compare_magic_event (Lisp_Event *UNUSED (e1), + Lisp_Event *UNUSED (e2)) { return 1; } static Hashcode -emacs_tty_hash_magic_event (Lisp_Event *UNUSED (e)) +tty_hash_magic_event (Lisp_Event *UNUSED (e)) { return 0; } static void -emacs_tty_handle_magic_event (Lisp_Event *UNUSED (emacs_event)) +tty_handle_magic_event (Lisp_Event *UNUSED (emacs_event)) { /* Nothing to do currently */ }  static void -emacs_tty_select_process (Lisp_Process *process, int doin, int doerr) +tty_select_process (Lisp_Process *process, int doin, int doerr) { int infd, errfd; ＠＠ -219,7 +222,7 ＠＠ } static void -emacs_tty_unselect_process (Lisp_Process *process, int doin, int doerr) +tty_unselect_process (Lisp_Process *process, int doin, int doerr) { int infd, errfd; ＠＠ -227,25 +230,25 ＠＠ } static void -emacs_tty_select_console (struct console *con) +tty_select_console (struct console *con) { event_stream_unixoid_select_console (con); } static void -emacs_tty_unselect_console (struct console *con) +tty_unselect_console (struct console *con) { event_stream_unixoid_unselect_console (con); } static void -emacs_tty_drain_queue (void) +tty_drain_queue (void) { drain_tty_devices (); } static void -emacs_tty_create_io_streams (void* inhandle, void* outhandle, +tty_create_io_streams (void* inhandle, void* outhandle, void *errhandle, Lisp_Object* instream, Lisp_Object* outstream, Lisp_Object* errstream, ＠＠ -259,7 +262,7 ＠＠ } static void -emacs_tty_delete_io_streams (Lisp_Object instream, +tty_delete_io_streams (Lisp_Object instream, Lisp_Object outstream, Lisp_Object errstream, USID* in_usid, ＠＠ -269,6 +272,12 ＠＠ (instream, outstream, errstream, in_usid, err_usid); } +static int +tty_current_event_timestamp (struct console *c) +{ + return (int) time (NULL); +} +  /************************************************************************/ /* initialization */ ＠＠ -279,21 +288,22 ＠＠ { tty_event_stream = xnew_and_zero (struct event_stream); - tty_event_stream->event_pending_p = emacs_tty_event_pending_p; - tty_event_stream->next_event_cb = emacs_tty_next_event; - tty_event_stream->handle_magic_event_cb = emacs_tty_handle_magic_event; - tty_event_stream->format_magic_event_cb = emacs_tty_format_magic_event; - tty_event_stream->compare_magic_event_cb= emacs_tty_compare_magic_event; - tty_event_stream->hash_magic_event_cb = emacs_tty_hash_magic_event; - tty_event_stream->add_timeout_cb = emacs_tty_add_timeout; - tty_event_stream->remove_timeout_cb = emacs_tty_remove_timeout; - tty_event_stream->select_console_cb = emacs_tty_select_console; - tty_event_stream->unselect_console_cb = emacs_tty_unselect_console; - tty_event_stream->select_process_cb = emacs_tty_select_process; - tty_event_stream->unselect_process_cb = emacs_tty_unselect_process; - tty_event_stream->drain_queue_cb = emacs_tty_drain_queue; - tty_event_stream->create_io_streams_cb = emacs_tty_create_io_streams; - tty_event_stream->delete_io_streams_cb = emacs_tty_delete_io_streams; + EVENT_STREAM_HAS_METHOD (tty, event_pending_p); + EVENT_STREAM_HAS_METHOD (tty, next_event); + EVENT_STREAM_HAS_METHOD (tty, handle_magic_event); + EVENT_STREAM_HAS_METHOD (tty, format_magic_event); + EVENT_STREAM_HAS_METHOD (tty, compare_magic_event); + EVENT_STREAM_HAS_METHOD (tty, hash_magic_event); + EVENT_STREAM_HAS_METHOD (tty, add_timeout); + EVENT_STREAM_HAS_METHOD (tty, remove_timeout); + EVENT_STREAM_HAS_METHOD (tty, select_console); + EVENT_STREAM_HAS_METHOD (tty, unselect_console); + EVENT_STREAM_HAS_METHOD (tty, select_process); + EVENT_STREAM_HAS_METHOD (tty, unselect_process); + EVENT_STREAM_HAS_METHOD (tty, drain_queue); + EVENT_STREAM_HAS_METHOD (tty, create_io_streams); + EVENT_STREAM_HAS_METHOD (tty, delete_io_streams); + EVENT_STREAM_HAS_METHOD (tty, current_event_timestamp); } void 1.1.8.1 +2 -2 XEmacs/xemacs/src/event-xlike-inc.c Index: event-xlike-inc.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/event-xlike-inc.c,v retrieving revision 1.1 retrieving revision 1.1.8.1 diff -u -r1.1 -r1.1.8.1 --- event-xlike-inc.c 2003/02/07 11:50:53 1.1 +++ event-xlike-inc.c 2005/02/16 00:43:06 1.1.8.1 ＠＠ -96,7 +96,7 ＠＠ /* HOW_MANY > 0 */ EVENT_CHAIN_LOOP (event, dispatch_event_queue) { - if (command_event_p (event)) + if (user_event_p (event)) { how_many--; if (how_many <= 0) ＠＠ -145,7 +145,7 ＠＠ EVENT_CHAIN_LOOP (event, dispatch_event_queue) { - if (command_event_p (event)) + if (user_event_p (event)) { how_many--; if (how_many <= 0) 1.65.4.1 +905 -234 XEmacs/xemacs/src/events.c Index: events.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/events.c,v retrieving revision 1.65 retrieving revision 1.65.4.1 diff -u -r1.65 -r1.65.4.1 --- events.c 2005/02/03 16:14:05 1.65 +++ events.c 2005/02/16 00:43:06 1.65.4.1 ＠＠ -1,7 +1,7 ＠＠ /* Events: printing them, converting them to and from characters. Copyright (C) 1991, 1992, 1993, 1994 Free Software Foundation, Inc. Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. - Copyright (C) 2001, 2002 Ben Wing. + Copyright (C) 2001, 2002, 2003, 2005 Ben Wing. This file is part of XEmacs. ＠＠ -33,6 +33,7 ＠＠ #include "events.h" #include "frame-impl.h" #include "glyphs.h" +#include "gui.h" #include "keymap.h" /* for key_desc_list_to_event() */ #include "lstream.h" #include "redisplay.h" ＠＠ -66,9 +67,39 ＠＠ Lisp_Object Qmouse_event_p; Lisp_Object Qprocess_event_p; -Lisp_Object Qkey_press, Qbutton_press, Qbutton_release, Qmisc_user; +Lisp_Object Qkey_press, Qbutton_press, Qbutton_release; Lisp_Object Qascii_character; +Lisp_Object Qdrop_data, Qdrop_data_type; +Lisp_Object Qscrollbar_value; + +Lisp_Object Qactivate_menu_selection; +Lisp_Object Qactivate_toolbar_selection; +Lisp_Object Qactivate_dialog_box_selection; +Lisp_Object Qactivate_widget_action; +Lisp_Object Qscrollbar_page_up; +Lisp_Object Qscrollbar_page_down; +Lisp_Object Qscrollbar_page_left; +Lisp_Object Qscrollbar_page_right; +Lisp_Object Qscrollbar_line_up; +Lisp_Object Qscrollbar_line_down; +Lisp_Object Qscrollbar_char_left; +Lisp_Object Qscrollbar_char_right; +Lisp_Object Qscrollbar_to_top; +Lisp_Object Qscrollbar_to_bottom; +Lisp_Object Qscrollbar_to_left; +Lisp_Object Qscrollbar_to_right; +Lisp_Object Qscrollbar_vertical_drag; +Lisp_Object Qscrollbar_horizontal_drag; +Lisp_Object Qnotify_no_menu_selection; +Lisp_Object Qnotify_dialog_box_cancelled; +Lisp_Object Qnotify_close_frame; +Lisp_Object Qnotify_cancel_mode; + +static int event_symbol_to_subtype (lisp_event_type type, Lisp_Object symbol); +static Lisp_Object event_property_1 (Lisp_Object event, Lisp_Object prop, + int nobad); +  /************************************************************************/ /* definition of event object */ ＠＠ -160,17 +191,44 ＠＠ static const struct sized_memory_description eval_data_description = { sizeof (Lisp_Eval_Data), eval_data_description_1 }; + +static const struct memory_description activate_data_description_1 [] = { + { XD_LISP_OBJECT, offsetof (struct Lisp_Activate_Data, text) }, + { XD_LISP_OBJECT, offsetof (struct Lisp_Activate_Data, callback) }, + { XD_END } +}; + +static const struct sized_memory_description activate_data_description = { + sizeof (Lisp_Activate_Data), activate_data_description_1 +}; + +static const struct memory_description scrollbar_data_description_1 [] = { + { XD_LISP_OBJECT, offsetof (struct Lisp_Scrollbar_Data, value) }, + { XD_END } +}; + +static const struct sized_memory_description scrollbar_data_description = { + sizeof (Lisp_Scrollbar_Data), scrollbar_data_description_1 +}; -static const struct memory_description misc_user_data_description_1 [] = { - { XD_LISP_OBJECT, offsetof (struct Lisp_Misc_User_Data, function) }, - { XD_LISP_OBJECT, offsetof (struct Lisp_Misc_User_Data, object) }, +static const struct memory_description drop_data_description_1 [] = { + { XD_LISP_OBJECT, offsetof (struct Lisp_Drop_Data, data_type) }, + { XD_LISP_OBJECT, offsetof (struct Lisp_Drop_Data, data) }, { XD_END } }; -static const struct sized_memory_description misc_user_data_description = { - sizeof (Lisp_Misc_User_Data), misc_user_data_description_1 +static const struct sized_memory_description drop_data_description = { + sizeof (Lisp_Drop_Data), drop_data_description_1 }; +static const struct memory_description notify_data_description_1 [] = { + { XD_END } +}; + +static const struct sized_memory_description notify_data_description = { + sizeof (Lisp_Notify_Data), notify_data_description_1 +}; + static const struct memory_description magic_eval_data_description_1 [] = { { XD_LISP_OBJECT, offsetof (struct Lisp_Magic_Eval_Data, object) }, { XD_END } ＠＠ -198,7 +256,10 ＠＠ { XD_BLOCK_ARRAY, magic_event, 1, { &magic_data_description } }, { XD_BLOCK_ARRAY, magic_eval_event, 1, { &magic_eval_data_description } }, { XD_BLOCK_ARRAY, eval_event, 1, { &eval_data_description } }, - { XD_BLOCK_ARRAY, misc_user_event, 1, { &misc_user_data_description } }, + { XD_BLOCK_ARRAY, activate_event, 1, { &activate_data_description } }, + { XD_BLOCK_ARRAY, scrollbar_event, 1, { &scrollbar_data_description } }, + { XD_BLOCK_ARRAY, drop_event, 1, { &drop_data_description } }, + { XD_BLOCK_ARRAY, notify_event, 1, { &notify_data_description } }, { XD_END } }; ＠＠ -252,13 +313,31 ＠＠ 0, 0, 0, 0, 0, eval_data_description, Lisp_Eval_Data); + +DEFINE_BASIC_LRECORD_IMPLEMENTATION ("activate-data", activate_data, + 0, /*dumpable-flag*/ + 0, 0, 0, 0, 0, + activate_data_description, + Lisp_Activate_Data); + +DEFINE_BASIC_LRECORD_IMPLEMENTATION ("scrollbar-data", scrollbar_data, + 0, /*dumpable-flag*/ + 0, 0, 0, 0, 0, + scrollbar_data_description, + Lisp_Scrollbar_Data); -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("misc-user-data", misc_user_data, +DEFINE_BASIC_LRECORD_IMPLEMENTATION ("drop-data", drop_data, 0, /*dumpable-flag*/ 0, 0, 0, 0, 0, - misc_user_data_description, - Lisp_Misc_User_Data); + drop_data_description, + Lisp_Drop_Data); +DEFINE_BASIC_LRECORD_IMPLEMENTATION ("notify-data", notify_data, + 0, /*dumpable-flag*/ + 0, 0, 0, 0, 0, + notify_data_description, + Lisp_Notify_Data); + DEFINE_BASIC_LRECORD_IMPLEMENTATION ("magic-eval-data", magic_eval_data, 0, /*dumpable-flag*/ 0, 0, 0, 0, 0, ＠＠ -291,16 +370,27 ＠＠ mark_object (EVENT_TIMEOUT_OBJECT (event)); break; case eval_event: - case misc_user_event: mark_object (EVENT_EVAL_FUNCTION (event)); mark_object (EVENT_EVAL_OBJECT (event)); break; + case activate_event: + mark_object (EVENT_ACTIVATE_TEXT (event)); + mark_object (EVENT_ACTIVATE_CALLBACK (event)); + break; + case scrollbar_event: + mark_object (EVENT_SCROLLBAR_VALUE (event)); + break; + case drop_event: + mark_object (EVENT_DROP_DATA_TYPE (event)); + mark_object (EVENT_DROP_DATA (event)); + break; case magic_eval_event: mark_object (EVENT_MAGIC_EVAL_OBJECT (event)); break; case button_press_event: case button_release_event: case pointer_motion_event: + case notify_event: case magic_event: case empty_event: case dead_event: ＠＠ -317,7 +407,7 ＠＠ { DECLARE_EISTRING_MALLOC (ei); write_c_string (printcharfun, str); - format_event_object (ei, obj, 0); + format_event_object (ei, obj, 1); write_eistring (printcharfun, ei); eifree (ei); } ＠＠ -366,17 +456,26 ＠＠ case empty_event: write_c_string (printcharfun, "#<empty-event"); break; - case misc_user_event: - write_fmt_string_lisp (printcharfun, "#<misc-user-event (%S", 1, - XEVENT_MISC_USER_FUNCTION (obj)); - write_fmt_string_lisp (printcharfun, " %S)", 1, - XEVENT_MISC_USER_OBJECT (obj)); + case activate_event: + write_fmt_string_lisp (printcharfun, "#<activate-event %s %S %S", 3, + Fevent_property (obj, Qsubtype), + XEVENT_ACTIVATE_TEXT (obj), + XEVENT_ACTIVATE_CALLBACK (obj)); break; - case eval_event: - write_fmt_string_lisp (printcharfun, "#<eval-event (%S", 1, - XEVENT_EVAL_FUNCTION (obj)); - write_fmt_string_lisp (printcharfun, " %S)", 1, - XEVENT_EVAL_OBJECT (obj)); + case scrollbar_event: + write_fmt_string_lisp (printcharfun, "#<scrollbar-event %s %S", 2, + Fevent_property (obj, Qsubtype), + XEVENT_SCROLLBAR_VALUE (obj)); + break; + case notify_event: + write_fmt_string_lisp (printcharfun, "#<notify-event %s", 1, + Fevent_property (obj, Qsubtype)); + break; + case drop_event: + write_fmt_string_lisp (printcharfun, "#<drop-event %S %S", 2, + XEVENT_DROP_DATA_TYPE (obj), + XEVENT_DROP_DATA (obj)); + print_event_1 (" ", obj, printcharfun); break; case dead_event: write_c_string (printcharfun, "#<DEALLOCATED-EVENT"); ＠＠ -416,6 +515,7 ＠＠ case button_press_event: case button_release_event: + /* #### are x and y also important? */ return (EVENT_BUTTON_BUTTON (e1) == EVENT_BUTTON_BUTTON (e2) && EVENT_BUTTON_MODIFIERS (e1) == EVENT_BUTTON_MODIFIERS (e2)); ＠＠ -423,15 +523,29 ＠＠ return (EVENT_MOTION_X (e1) == EVENT_MOTION_X (e2) && EVENT_MOTION_Y (e1) == EVENT_MOTION_Y (e2)); - case misc_user_event: - return (internal_equal (EVENT_EVAL_FUNCTION (e1), - EVENT_EVAL_FUNCTION (e2), 0) && - internal_equal (EVENT_EVAL_OBJECT (e1), - EVENT_EVAL_OBJECT (e2), 0) && - /* #### is this really needed for equality - or is x and y also important? */ - EVENT_MISC_USER_BUTTON (e1) == EVENT_MISC_USER_BUTTON (e2) && - EVENT_MISC_USER_MODIFIERS (e1) == EVENT_MISC_USER_MODIFIERS (e2)); + case activate_event: + return (EVENT_ACTIVATE_TYPE (e1) == EVENT_ACTIVATE_TYPE (e2) && + internal_equal (EVENT_ACTIVATE_TEXT (e1), + EVENT_ACTIVATE_TEXT (e2), 0) && + internal_equal (EVENT_ACTIVATE_CALLBACK (e1), + EVENT_ACTIVATE_CALLBACK (e2), 0)); + + case scrollbar_event: + return (EVENT_SCROLLBAR_TYPE (e1) == EVENT_SCROLLBAR_TYPE (e2) && + internal_equal (EVENT_SCROLLBAR_VALUE (e1), + EVENT_SCROLLBAR_VALUE (e2), 0)); + + case notify_event: + return (EVENT_NOTIFY_TYPE (e1) == EVENT_NOTIFY_TYPE (e2)); + + case drop_event: + return (internal_equal (EVENT_DROP_DATA_TYPE (e1), + EVENT_DROP_DATA_TYPE (e2), 0) && + internal_equal (EVENT_DROP_DATA (e1), + EVENT_DROP_DATA (e2), 0) && + /* #### are x and y also important? */ + EVENT_DROP_BUTTON (e1) == EVENT_DROP_BUTTON (e2) && + EVENT_DROP_MODIFIERS (e1) == EVENT_DROP_MODIFIERS (e2)); case eval_event: return (internal_equal (EVENT_EVAL_FUNCTION (e1), ＠＠ -482,11 +596,22 ＠＠ case pointer_motion_event: return HASH3 (hash, EVENT_MOTION_X (e), EVENT_MOTION_Y (e)); - case misc_user_event: - return HASH5 (hash, - internal_hash (EVENT_MISC_USER_FUNCTION (e), depth + 1), - internal_hash (EVENT_MISC_USER_OBJECT (e), depth + 1), - EVENT_MISC_USER_BUTTON (e), EVENT_MISC_USER_MODIFIERS (e)); + case activate_event: + return HASH4 (hash, EVENT_ACTIVATE_TYPE (e), + internal_hash (EVENT_ACTIVATE_TEXT (e), depth + 1), + internal_hash (EVENT_ACTIVATE_CALLBACK (e), depth + 1)); + + case scrollbar_event: + return HASH3 (hash, EVENT_SCROLLBAR_TYPE (e), + internal_hash (EVENT_SCROLLBAR_VALUE (e), depth + 1)); + + case notify_event: + return HASH2 (hash, EVENT_SCROLLBAR_TYPE (e)); + + case drop_event: + return HASH5 (hash, internal_hash (EVENT_DROP_DATA_TYPE (e), depth + 1), + internal_hash (EVENT_DROP_DATA (e), depth + 1), + EVENT_DROP_BUTTON (e), EVENT_DROP_MODIFIERS (e)); case eval_event: return HASH3 (hash, internal_hash (EVENT_EVAL_FUNCTION (e), depth + 1), ＠＠ -511,47 +636,84 ＠＠ return 0; /* unreached */ } -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("event", event, - 0, /*dumpable-flag*/ - mark_event, print_event, 0, event_equal, - event_hash, event_description, - Lisp_Event); +static Lisp_Object +event_getprop (Lisp_Object obj, Lisp_Object prop) +{ + return event_property_1 (obj, prop, 0); +} + +static Lisp_Object +event_plist (Lisp_Object obj) +{ + return Fevent_properties (obj); +} +DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("event", event, + 0, /*dumpable-flag*/ + mark_event, print_event, 0, + event_equal, + event_hash, event_description, + /* no putprop or remprop + because events are + read-only */ + event_getprop, 0, + 0, event_plist, + Lisp_Event); + DEFUN ("make-event", Fmake_event, 0, 2, 0, /* Return a new event of type TYPE, with properties described by PLIST. TYPE is a symbol, either `empty', `key-press', `button-press', - `button-release', `misc-user' or `motion'. If TYPE is nil, it - defaults to `empty'. + `button-release', `motion', `activate', `scrollbar', `notify', or `drop'. + If TYPE is nil, it defaults to `empty'. PLIST is a property list, the properties being compatible to those returned by `event-properties'. The following properties are allowed: - channel -- The event channel, a frame or a console. For - button-press, button-release, misc-user and motion events, - this must be a frame. For key-press events, it must be - a console. If channel is unspecified, it will be set to - the selected frame or selected console, as appropriate. - key -- The event key, a symbol or character. Allowed only for - keypress events. - button -- The event button, integer 1, 2 or 3. Allowed for - button-press, button-release and misc-user events. - modifiers -- The event modifiers, a list of modifier symbols. Allowed - for key-press, button-press, button-release, motion and - misc-user events. - function -- Function. Allowed for misc-user events only. - object -- An object, function's parameter. Allowed for misc-user - events only. - x -- The event X coordinate, an integer. This is relative - to the left of CHANNEL's root window. Allowed for - motion, button-press, button-release and misc-user events. - y -- The event Y coordinate, an integer. This is relative - to the top of CHANNEL's root window. Allowed for - motion, button-press, button-release and misc-user events. - timestamp -- The event timestamp, a non-negative integer. Allowed for - all types of events. If unspecified, it will be set to 0 - by default. + channel -- The event channel -- a window, frame, console, or + image instance, depending on event type. For + button-press, button-release, motion, activate (except + for widget actions), drop, and notify events, this + must be a frame. For key-press events, it must be a + console. For scrollbar events, it must be a window. + For widget actions, this must be an image instance, + which indicates which widget instance was activated. + For eval events (uncreatable by this function -- use + `enqueue-eval-event'), the channel is nil. For magic + events (uncreatable in Lisp; generated internally + when necessary), the channel may be a device, frame, + or nil. + + If channel is unspecified, it will be set to the + selected window, frame or console, as appropriate -- + except in widget actions, where an image instance must + be specified. + key -- The event key, a symbol or character. Allowed only for + keypress events. + button -- The event button, integer 1, 2 or 3. Allowed for + button-press, button-release and drop events. + modifiers -- The event modifiers, a list of modifier symbols. Allowed + for key-press, button-press, button-release, motion and + drop events. + subtype -- The event's subtype. Allowed for activate, scrollbar and + notify events. + text -- The event's text. Allowed for activate events only. + callback -- The event's callback. Allowed for activate events only. + scrollbar-value -- The event's scrollbar value. Allowed for scrollbar + events only. + drop-data -- The event's drop data. Allowed for drop events only. + drop-data-type -- The data type of the event's drop data. Allowed for + drop events only. + x -- The event X coordinate, an integer. This is relative + to the left of CHANNEL's root window. Allowed for + motion, button-press, button-release and drop events. + y -- The event Y coordinate, an integer. This is relative + to the top of CHANNEL's root window. Allowed for + motion, button-press, button-release and drop events. + timestamp -- The event timestamp, a non-negative integer. Allowed for + all types of events. If unspecified, it will be set to 0 + by default. For event type `empty', PLIST must be nil. `button-release', or `motion'. If TYPE is left out, it defaults to ＠＠ -610,11 +772,29 ＠＠ set_event_type (e, button_release_event); else if (EQ (type, Qmotion)) set_event_type (e, pointer_motion_event); - else if (EQ (type, Qmisc_user)) + else if (EQ (type, Qactivate)) + { + set_event_type (e, activate_event); + SET_EVENT_ACTIVATE_TYPE (e, (enum activate_event_type) -1); + SET_EVENT_ACTIVATE_TEXT (e, Qnil); + SET_EVENT_ACTIVATE_CALLBACK (e, Qnil); + } + else if (EQ (type, Qscrollbar)) + { + set_event_type (e, scrollbar_event); + SET_EVENT_SCROLLBAR_TYPE (e, (enum scrollbar_event_type) -1); + SET_EVENT_SCROLLBAR_VALUE (e, Qnil); + } + else if (EQ (type, Qnotify)) + { + set_event_type (e, notify_event); + SET_EVENT_NOTIFY_TYPE (e, (enum notify_event_type) -1); + } + else if (EQ (type, Qdrop)) { - set_event_type (e, misc_user_event); - SET_EVENT_MISC_USER_FUNCTION (e, Qnil); - SET_EVENT_MISC_USER_OBJECT (e, Qnil); + set_event_type (e, drop_event); + SET_EVENT_DROP_DATA_TYPE (e, Qnil); + SET_EVENT_DROP_DATA (e, Qnil); } else { ＠＠ -640,6 +820,17 ＠＠ if (!CONSOLEP (value)) value = wrong_type_argument (Qconsolep, value); } + else if (e->event_type == scrollbar_event) + { + if (!WINDOWP (value)) + value = wrong_type_argument (Qwindowp, value); + } + else if (e->event_type == activate_event && + EVENT_ACTIVATE_TYPE (e) == ACTIVATE_WIDGET_ACTION) + { + if (!IMAGE_INSTANCEP (value)) + value = wrong_type_argument (Qimage_instancep, value); + } else { if (!FRAMEP (value)) ＠＠ -672,8 +863,8 ＠＠ case button_release_event: SET_EVENT_BUTTON_BUTTON (e, XINT (value)); break; - case misc_user_event: - SET_EVENT_MISC_USER_BUTTON (e, XINT (value)); + case drop_event: + SET_EVENT_DROP_BUTTON (e, XINT (value)); break; default: WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); ＠＠ -714,8 +905,8 ＠＠ case pointer_motion_event: SET_EVENT_MOTION_MODIFIERS (e, modifiers); break; - case misc_user_event: - SET_EVENT_MISC_USER_MODIFIERS (e, modifiers); + case drop_event: + SET_EVENT_DROP_MODIFIERS (e, modifiers); break; default: WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); ＠＠ -729,7 +920,7 ＠＠ case pointer_motion_event: case button_press_event: case button_release_event: - case misc_user_event: + case drop_event: /* Allow negative values, so we can specify toolbar positions. */ CHECK_INT (value); ＠＠ -747,7 +938,7 ＠＠ case pointer_motion_event: case button_press_event: case button_release_event: - case misc_user_event: + case drop_event: /* Allow negative values; see above. */ CHECK_INT (value); coord_y = XINT (value); ＠＠ -761,26 +952,98 ＠＠ { CHECK_NATNUM (value); SET_EVENT_TIMESTAMP (e, XINT (value)); + } + else if (EQ (keyword, Qdrop_data_type)) + { + switch (e->event_type) + { + case drop_event: + SET_EVENT_DROP_DATA_TYPE (e, value); + break; + default: + WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); + break; + } } - else if (EQ (keyword, Qfunction)) + else if (EQ (keyword, Qdrop_data)) { switch (EVENT_TYPE (e)) { - case misc_user_event: - SET_EVENT_MISC_USER_FUNCTION (e, value); + case drop_event: + SET_EVENT_DROP_DATA (e, value); break; default: WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); break; } } - else if (EQ (keyword, Qobject)) + else if (EQ (keyword, Qtext)) { switch (EVENT_TYPE (e)) + { + case activate_event: + SET_EVENT_ACTIVATE_TEXT (e, value); + break; + default: + WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); + break; + } + } + else if (EQ (keyword, Qcallback)) + { + switch (e->event_type) + { + case activate_event: + SET_EVENT_ACTIVATE_CALLBACK (e, value); + break; + default: + WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); + break; + } + } + else if (EQ (keyword, Qscrollbar_value)) + { + switch (e->event_type) + { + case scrollbar_event: + SET_EVENT_SCROLLBAR_VALUE (e, value); + break; + default: + WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); + break; + } + } + else if (EQ (keyword, Qsubtype)) + { + switch (e->event_type) { - case misc_user_event: - SET_EVENT_MISC_USER_OBJECT (e, value); + case activate_event: + SET_EVENT_ACTIVATE_TYPE + (e, + (enum activate_event_type) + event_symbol_to_subtype (activate_event, value)); + if (EVENT_ACTIVATE_TYPE (e) < 0) + invalid_constant ("Invalid subtype", value); + break; + + case scrollbar_event: + SET_EVENT_SCROLLBAR_TYPE + (e, + (enum scrollbar_event_type) + event_symbol_to_subtype (scrollbar_event, value)); + if (EVENT_SCROLLBAR_TYPE (e) < 0) + invalid_constant ("Invalid subtype", value); break; + + case notify_event: + SET_EVENT_NOTIFY_TYPE + (e, + (enum notify_event_type) + event_symbol_to_subtype (notify_event, value)); + if (EVENT_NOTIFY_TYPE (e) < 0) + invalid_constant ("Invalid subtype", value); + break; + default: WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); break; ＠＠ -796,6 +1059,12 ＠＠ { if (EVENT_TYPE (e) == key_press_event) EVENT_CHANNEL (e) = Vselected_console; + else if (e->event_type == scrollbar_event) + EVENT_CHANNEL (e) = Fselected_window (Qnil); + else if (e->event_type == activate_event && + EVENT_ACTIVATE_TYPE (e) == ACTIVATE_WIDGET_ACTION) + sferror ("A channel must be supplied to make a widget-action event", + plist); else EVENT_CHANNEL (e) = Fselected_frame (Qnil); } ＠＠ -818,12 +1087,12 ＠＠ SET_EVENT_BUTTON_X (e, coord_x); SET_EVENT_BUTTON_Y (e, coord_y); break; - case misc_user_event: - SET_EVENT_MISC_USER_X (e, coord_x); - SET_EVENT_MISC_USER_Y (e, coord_y); + case drop_event: + SET_EVENT_DROP_X (e, coord_x); + SET_EVENT_DROP_Y (e, coord_y); break; default: - ABORT (); + break; } } ＠＠ -833,25 +1102,36 ＠＠ case key_press_event: if (UNBOUNDP (EVENT_KEY_KEYSYM (e))) sferror ("A key must be specified to make a keypress event", - plist); + plist); break; case button_press_event: if (!EVENT_BUTTON_BUTTON (e)) - sferror - ("A button must be specified to make a button-press event", - plist); + sferror ("A button must be specified to make a button-press event", + plist); break; case button_release_event: if (!EVENT_BUTTON_BUTTON (e)) - sferror - ("A button must be specified to make a button-release event", - plist); - break; - case misc_user_event: - if (NILP (EVENT_MISC_USER_FUNCTION (e))) - sferror ("A function must be specified to make a misc-user event", - plist); + sferror ("A button must be specified to make a button-release event", + plist); break; + case activate_event: + if (NILP (EVENT_ACTIVATE_CALLBACK (e))) + sferror ("A callback must be specified to make an activate event", + plist); + if (EVENT_ACTIVATE_TYPE (e) < 0) + sferror ("A subtype must be specified to make an activate event", + plist); + break; + case notify_event: + if (EVENT_NOTIFY_TYPE (e) < 0) + sferror ("A subtype must be specified to make a notify event", + plist); + break; + case scrollbar_event: + if (EVENT_SCROLLBAR_TYPE (e) < 0) + sferror ("A subtype must be specified to make a scrollbar event", + plist); + break; default: break; } ＠＠ -1174,6 +1454,34 ＠＠ QKspace, QKdelete; int +user_event_p (Lisp_Object event) +{ + switch (XEVENT_TYPE (event)) + { + case key_press_event: + case button_press_event: + case button_release_event: + case activate_event: + case drop_event: + case notify_event: + /* #### perhaps scrollbar events should not be user events? We could + #### simply not make them user events except for the god-damned + #### point movement. Real solution is fix the requirement that + #### point is always oncreen! Maybe it would just be OK to make + #### them non-user events, even with the point motion? What sort + #### of hooks on post-command-hook are there to check out point + #### motion, and would get messed up? Point can also move as a + #### result of dragging, or process output inserted into a buffer, + #### or possibly a "mouse motion selects window under mouse" + #### policy, etc. What about that? --ben */ + case scrollbar_event: + return 1; + default: + return 0; + } +} + +int command_event_p (Lisp_Object event) { switch (XEVENT_TYPE (event)) ＠＠ -1181,13 +1489,45 ＠＠ case key_press_event: case button_press_event: case button_release_event: - case misc_user_event: + case activate_event: return 1; + default: return 0; } } +DEFUN ("user-event-p", Fuser_event_p, 1, 1, 0, /* +Return t if EVENT is a user event. +A user event is a key press, button press, button release, activate, +scrollbar, notify or drop event. (See `next-event' for more info about +these event types.) User events terminate a `sit-for' and the event- +processing loop in `next-command-event'. See also `command-event-p'. +*/ + (event)) +{ + CHECK_LIVE_EVENT (event); + return user_event_p (event) ? Qt : Qnil; +} + +DEFUN ("command-event-p", Fcommand_event_p, 1, 1, 0, /* +Return t if EVENT is a command event. + +A command event is a key press, button press, button release, or activate +event. (This does not include scrollbar, notify, or drop events). A +command event is an event that participates in the formation of commands, +i.e. key sequences and the like. Command events have associated callbacks +or handlers (which generally satisfy `commandp'), and are dispatched using +`command-execute'. The non-command user events are dispatched by calling a +particular event-specific handler (e.g. as stored in +`scrollbar-event-handler'). See also `user-event-p'. +*/ + (event)) +{ + CHECK_LIVE_EVENT (event); + return command_event_p (event) ? Qt : Qnil; +} + /* USE_CONSOLE_META_FLAG is as in `character-to-event'. DO_BACKSPACE_MAPPING means that if CON is a TTY, and C is a the TTY's backspace character, the event will have keysym `backspace' instead of ＠＠ -1288,7 +1628,9 ＠＠ k = QKspace; set_event_type (event, key_press_event); - SET_EVENT_TIMESTAMP_ZERO (event); /* #### */ + SET_EVENT_TIMESTAMP (event, + current_time_from_event_channel_or_else + (wrap_console (con))); SET_EVENT_CHANNEL (event, wrap_console (con)); SET_EVENT_KEY_KEYSYM (event, (!NILP (k) ? k : make_char (c))); SET_EVENT_KEY_MODIFIERS (event, m); ＠＠ -1457,7 +1799,7 ＠＠ if (STRINGP (seq)) { - Ichar ch = string_ichar (seq, n); + Ichar ch = string_ichar_at (seq, n); Fcharacter_to_event (make_char (ch), event, Qnil, Qnil); } else ＠＠ -1489,10 +1831,11 ＠＠ /* Concatenate a string description of EVENT onto the end of BUF. If - BRIEF, use short forms for keys, e.g. C- instead of control-. */ + FROM_PRINT_EVENT, use longer forms for keys, e.g. control- instead of + C-, and don't print name (in case of drop events). */ void -format_event_object (Eistring *buf, Lisp_Object event, int brief) +format_event_object (Eistring *buf, Lisp_Object event, int from_print_event) { int mouse_p = 0; int mod = 0; ＠＠ -1505,7 +1848,7 ＠＠ mod = XEVENT_KEY_MODIFIERS (event); key = XEVENT_KEY_KEYSYM (event); /* Hack. */ - if (! brief && CHARP (key) && + if (from_print_event && CHARP (key) && mod & (XEMACS_MOD_CONTROL | XEMACS_MOD_META | XEMACS_MOD_SUPER | XEMACS_MOD_HYPER)) { ＠＠ -1527,6 +1870,16 ＠＠ key = make_char (XEVENT_BUTTON_BUTTON (event) + '0'); break; } + case drop_event: + { + mouse_p = 1; + mod = XEVENT_DROP_MODIFIERS (event); + key = make_char (XEVENT_DROP_BUTTON (event) + '0'); + if (!from_print_event) + eicat_ascii (buf, "drop/"); + break; + } + case magic_event: { Lisp_Object stream; ＠＠ -1544,18 +1897,21 ＠＠ } case magic_eval_event: eicat_ascii (buf, "magic-eval"); return; case pointer_motion_event: eicat_ascii (buf, "motion"); return; - case misc_user_event: eicat_ascii (buf, "misc-user"); return; - case eval_event: eicat_ascii (buf, "eval"); return; + case activate_event: eicat_ascii (buf, "activate"); return; + case scrollbar_event: eicat_ascii (buf, "scrollbar"); return; + case notify_event: eicat_ascii (buf, "notify"); return; + case eval_event: eicat_ascii (buf, "eval"); return; case process_event: eicat_ascii (buf, "process"); return; case timeout_event: eicat_ascii (buf, "timeout"); return; - case empty_event: eicat_ascii (buf, "empty"); return; + case empty_event: eicat_ascii (buf, "empty"); return; case dead_event: eicat_ascii (buf, "DEAD-EVENT"); return; default: ABORT (); return; } -#define modprint(x,y) \ - do { if (brief) eicat_ascii (buf, (y)); else eicat_ascii (buf, (x)); } while (0) +#define modprint(x,y) \ + do { if (!from_print_event) eicat_ascii (buf, (y)); else eicat_ascii (buf, (x)); \ + } while (0) if (mod & XEMACS_MOD_CONTROL) modprint ("control-", "C-"); if (mod & XEMACS_MOD_META) modprint ("meta-", "M-"); if (mod & XEMACS_MOD_SUPER) modprint ("super-", "S-"); ＠＠ -1575,7 +1931,7 ＠＠ else if (SYMBOLP (key)) { const Ascbyte *str = 0; - if (brief) + if (!from_print_event) { if (EQ (key, QKlinefeed)) str = "LFD"; else if (EQ (key, QKtab)) str = "TAB"; ＠＠ -1709,15 +2065,21 ＠＠ key-press A key was pressed. button-press A mouse button was pressed. button-release A mouse button was released. -misc-user Some other user action happened; typically, this is - a menu selection or scrollbar action. +activate A menu item, toolbar item, or dialog box item was selected, + or a widget was activated (button pressed, etc.). In general, + this covers user actions that trigger a programmable Lisp + callback. +scrollbar The user did something with a scrollbar. +drop An object was dragged from somewhere and dropped onto an + XEmacs frame. +notify Some miscellaneous action happened; typically involves + cancelling or closing something. motion The mouse moved. process Input is available from a subprocess. timeout A timeout has expired. eval This causes a specified action to occur when dispatched. magic Some window-system-specific event has occurred. empty The event has been allocated but not assigned. - */ (event)) { ＠＠ -1727,7 +2089,10 ＠＠ case key_press_event: return Qkey_press; case button_press_event: return Qbutton_press; case button_release_event: return Qbutton_release; - case misc_user_event: return Qmisc_user; + case activate_event: return Qactivate; + case scrollbar_event: return Qscrollbar; + case notify_event: return Qnotify; + case drop_event: return Qdrop; case pointer_motion_event: return Qmotion; case process_event: return Qprocess; case timeout_event: return Qtimeout; ＠＠ -1792,7 +2157,7 ＠＠ #define CHECK_EVENT_TYPE2(e,t1,t2,sym) do { \ CHECK_LIVE_EVENT (e); \ { \ - emacs_event_type CET_type = XEVENT_TYPE (e); \ + lisp_event_type CET_type = XEVENT_TYPE (e); \ if (CET_type != (t1) && \ CET_type != (t2)) \ e = wrong_type_argument (sym,e); \ ＠＠ -1802,7 +2167,7 ＠＠ #define CHECK_EVENT_TYPE3(e,t1,t2,t3,sym) do { \ CHECK_LIVE_EVENT (e); \ { \ - emacs_event_type CET_type = XEVENT_TYPE (e); \ + lisp_event_type CET_type = XEVENT_TYPE (e); \ if (CET_type != (t1) && \ CET_type != (t2) && \ CET_type != (t3)) \ ＠＠ -1810,33 +2175,6 ＠＠ } \ } while (0) -DEFUN ("event-key", Fevent_key, 1, 1, 0, /* -Return the Keysym of the key-press event EVENT. -This will be a character if the event is associated with one, else a symbol. -*/ - (event)) -{ - CHECK_EVENT_TYPE (event, key_press_event, Qkey_press_event_p); - return XEVENT_KEY_KEYSYM (event); -} - -DEFUN ("event-button", Fevent_button, 1, 1, 0, /* -Return the button-number of the button-press or button-release event EVENT. -*/ - (event)) -{ - CHECK_EVENT_TYPE3 (event, button_press_event, button_release_event, - misc_user_event, Qbutton_event_p); -#ifdef HAVE_WINDOW_SYSTEM - if (XEVENT_TYPE (event) == misc_user_event) - return make_int (XEVENT_MISC_USER_BUTTON (event)); - else - return make_int (XEVENT_BUTTON_BUTTON (event)); -#else /* !HAVE_WINDOW_SYSTEM */ - return Qzero; -#endif /* !HAVE_WINDOW_SYSTEM */ -} - DEFUN ("event-modifier-bits", Fevent_modifier_bits, 1, 1, 0, /* Return a number representing the modifier keys and buttons which were down when the given mouse or keyboard event was produced. ＠＠ -1855,8 +2193,8 ＠＠ return make_int (XEVENT_BUTTON_MODIFIERS (event)); case pointer_motion_event: return make_int (XEVENT_MOTION_MODIFIERS (event)); - case misc_user_event: - return make_int (XEVENT_MISC_USER_MODIFIERS (event)); + case drop_event: + return make_int (XEVENT_DROP_MODIFIERS (event)); default: event = wrong_type_argument (intern ("key-or-mouse-event-p"), event); goto again; ＠＠ -1944,10 +2282,10 ＠＠ *x = XEVENT_BUTTON_X (event); *y = XEVENT_BUTTON_Y (event); } - else if (XEVENT_TYPE (event) == misc_user_event) + else if (XEVENT_TYPE (event) == drop_event) { - *x = XEVENT_MISC_USER_X (event); - *y = XEVENT_MISC_USER_Y (event); + *x = XEVENT_DROP_X (event); + *y = XEVENT_DROP_Y (event); } else return 0; ＠＠ -2099,9 +2437,9 ＠＠ pix_x = XEVENT_BUTTON_X (event); pix_y = XEVENT_BUTTON_Y (event); break; - case misc_user_event : - pix_x = XEVENT_MISC_USER_X (event); - pix_y = XEVENT_MISC_USER_Y (event); + case drop_event : + pix_x = XEVENT_DROP_X (event); + pix_y = XEVENT_DROP_Y (event); break; default: dead_wrong_type_argument (Qmouse_event_p, event); ＠＠ -2209,38 +2547,87 ＠＠ return result == OVER_V_DIVIDER ? Qt : Qnil; } -struct console * -event_console_or_selected (Lisp_Object event) +static Lisp_Object +event_channel_to_console (Lisp_Object channel) { - Lisp_Object channel = EVENT_CHANNEL (XEVENT (event)); - Lisp_Object console = CDFW_CONSOLE (channel); + if (IMAGE_INSTANCEP (channel)) + channel = XIMAGE_INSTANCE_DOMAIN (channel); + return Fcdfw_console (channel); +} - if (NILP (console)) - console = Vselected_console; +/* Return the current time for user in events, by hook or by crook if + necessary -- i.e. using the selected console. CHANNEL can be nil, + in which case the selected console will be used to fetch a time. - return XCONSOLE (console); + #### Unfortunately things will be a big mess when you have timestamps + #### from different consoles -- need to have some way of having a + #### timestamp corresponding to a recognizable time, or equivalently, of + #### converting between the different timestamps. */ +int +current_time_from_event_channel_or_else (Lisp_Object channel) +{ + channel = event_channel_to_console (channel); + if (!CONSOLEP (channel)) + { + channel = Vselected_console; + if (!CONSOLEP (channel)) /* #### Can it occur? */ + return 0; + } + return event_stream_current_event_timestamp (XCONSOLE (channel)); } -DEFUN ("event-channel", Fevent_channel, 1, 1, 0, /* -Return the channel that the event EVENT occurred on. -This will be a frame, device, console, or nil for some types -of events (e.g. eval events). +DEFUN ("event-console", Fevent_console, 1, 1, 0, /* +Return the console that EVENT occurred on. +This will be nil for some types of events (e.g. eval events). */ (event)) { CHECK_LIVE_EVENT (event); - return EVENT_CHANNEL (XEVENT (event)); + return event_channel_to_console (XEVENT_CHANNEL (event)); +} + +struct console * +event_console_or_selected (Lisp_Object event) +{ + Lisp_Object console = Fevent_console (event); + + if (NILP (console)) + console = Vselected_console; + + return XCONSOLE (console); } DEFUN ("event-window", Fevent_window, 1, 1, 0, /* -Return the window over which mouse event EVENT occurred. +Return the window that the event EVENT occurred on. +This will be nil for some types of events (non-mouse events). This may be nil if the event occurred in the border or over a toolbar. The modeline is considered to be within the window it describes. */ (event)) { struct window *w; + Lisp_Object channel; + + CHECK_LIVE_EVENT (event); + channel = XEVENT_CHANNEL (event); + + if (IMAGE_INSTANCEP (channel)) + channel = XIMAGE_INSTANCE_DOMAIN (channel); + if (WINDOWP (channel)) + return channel; + + switch (XEVENT (event)->event_type) + { + case pointer_motion_event : + case button_press_event : + case button_release_event : + case drop_event : + break; + default: + return Qnil; + } + event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, 0, 0); if (!w) ＠＠ -2409,18 +2796,190 ＠＠ #endif } -DEFUN ("event-process", Fevent_process, 1, 1, 0, /* -Return the process of the process-output event EVENT. -*/ - (event)) +static Lisp_Object +event_subtype_to_symbol (lisp_event_type type, int subtype) +{ +#define FROB(c, lisp) if (subtype == c) return lisp + switch (type) + { + case activate_event: + + FROB (ACTIVATE_MENU_SELECTION, Qactivate_menu_selection); + FROB (ACTIVATE_TOOLBAR_SELECTION, Qactivate_toolbar_selection); + FROB (ACTIVATE_DIALOG_BOX_SELECTION, Qactivate_dialog_box_selection); + FROB (ACTIVATE_WIDGET_ACTION, Qactivate_widget_action); + ABORT (); return Qnil; + + case scrollbar_event: + + FROB (SCROLLBAR_PAGE_UP, Qscrollbar_page_up); + FROB (SCROLLBAR_PAGE_DOWN, Qscrollbar_page_down); + FROB (SCROLLBAR_PAGE_LEFT, Qscrollbar_page_left); + FROB (SCROLLBAR_PAGE_RIGHT, Qscrollbar_page_right); + FROB (SCROLLBAR_LINE_UP, Qscrollbar_line_up); + FROB (SCROLLBAR_LINE_DOWN, Qscrollbar_line_down); + FROB (SCROLLBAR_CHAR_LEFT, Qscrollbar_char_left); + FROB (SCROLLBAR_CHAR_RIGHT, Qscrollbar_char_right); + FROB (SCROLLBAR_TO_TOP, Qscrollbar_to_top); + FROB (SCROLLBAR_TO_BOTTOM, Qscrollbar_to_bottom); + FROB (SCROLLBAR_TO_LEFT, Qscrollbar_to_left); + FROB (SCROLLBAR_TO_RIGHT, Qscrollbar_to_right); + FROB (SCROLLBAR_VERTICAL_DRAG, Qscrollbar_vertical_drag); + FROB (SCROLLBAR_HORIZONTAL_DRAG, Qscrollbar_horizontal_drag); + ABORT (); return Qnil; + + case notify_event: + + FROB (NOTIFY_NO_MENU_SELECTION, Qnotify_no_menu_selection); + FROB (NOTIFY_DIALOG_BOX_CANCELLED, Qnotify_dialog_box_cancelled); + FROB (NOTIFY_CLOSE_FRAME, Qnotify_close_frame); + FROB (NOTIFY_CANCEL_MODE, Qnotify_cancel_mode); + ABORT (); return Qnil; + + default: + ABORT (); return Qnil; + } + +#undef FROB +} + +static int +event_symbol_to_subtype (lisp_event_type type, Lisp_Object symbol) +{ +#define FROB(c, lisp) if (EQ (symbol, lisp)) return c + switch (type) + { + case activate_event: + + FROB (ACTIVATE_MENU_SELECTION, Qactivate_menu_selection); + FROB (ACTIVATE_TOOLBAR_SELECTION, Qactivate_toolbar_selection); + FROB (ACTIVATE_DIALOG_BOX_SELECTION, Qactivate_dialog_box_selection); + FROB (ACTIVATE_WIDGET_ACTION, Qactivate_widget_action); + return -1; + + case scrollbar_event: + + FROB (SCROLLBAR_PAGE_UP, Qscrollbar_page_up); + FROB (SCROLLBAR_PAGE_DOWN, Qscrollbar_page_down); + FROB (SCROLLBAR_PAGE_LEFT, Qscrollbar_page_left); + FROB (SCROLLBAR_PAGE_RIGHT, Qscrollbar_page_right); + FROB (SCROLLBAR_LINE_UP, Qscrollbar_line_up); + FROB (SCROLLBAR_LINE_DOWN, Qscrollbar_line_down); + FROB (SCROLLBAR_CHAR_LEFT, Qscrollbar_char_left); + FROB (SCROLLBAR_CHAR_RIGHT, Qscrollbar_char_right); + FROB (SCROLLBAR_TO_TOP, Qscrollbar_to_top); + FROB (SCROLLBAR_TO_BOTTOM, Qscrollbar_to_bottom); + FROB (SCROLLBAR_TO_LEFT, Qscrollbar_to_left); + FROB (SCROLLBAR_TO_RIGHT, Qscrollbar_to_right); + FROB (SCROLLBAR_VERTICAL_DRAG, Qscrollbar_vertical_drag); + FROB (SCROLLBAR_HORIZONTAL_DRAG, Qscrollbar_horizontal_drag); + return -1; + + case notify_event: + + FROB (NOTIFY_NO_MENU_SELECTION, Qnotify_no_menu_selection); + FROB (NOTIFY_DIALOG_BOX_CANCELLED, Qnotify_dialog_box_cancelled); + FROB (NOTIFY_CLOSE_FRAME, Qnotify_close_frame); + FROB (NOTIFY_CANCEL_MODE, Qnotify_cancel_mode); + return -1; + + default: + ABORT (); + return -1; + } + +#undef FROB +} + +static void +event_function_and_object (Lisp_Object event, Lisp_Object *function, + Lisp_Object *object) { - CHECK_EVENT_TYPE (event, process_event, Qprocess_event_p); - return XEVENT_PROCESS_PROCESS (event); + switch (XEVENT_TYPE (event)) + { + case activate_event: + { + Lisp_Object callback = XEVENT_ACTIVATE_CALLBACK (event); + if (EQ (callback, Qquit)) + { + *function = Qeval; + *object = list3 (Qsignal, list2 (Qquote, Qquit), Qnil); + } + else if (!NILP (Fcommandp (callback))) + { + *function = Qcall_interactively; + *object = callback; + } + else if (CONSP (callback)) + { + *function = Qeval; + *object = callback; + } + else + { + *function = Qeval; + *object = list3 (Qsignal, + list2 (Qquote, Qerror), + list2 (Qquote, list2 (build_msg_string + ("illegal callback"), + callback))); + } + } + case notify_event: + { + switch (XEVENT_NOTIFY_TYPE (event)) + { + case NOTIFY_NO_MENU_SELECTION: + case NOTIFY_DIALOG_BOX_CANCELLED: + *function = Qrun_hooks; + *object = Qmenu_no_selection_hook; + break; + + case NOTIFY_CLOSE_FRAME: + *function = Qeval; + *object = list3 (Qdelete_frame, XEVENT_CHANNEL (event), + Qt); + break; + + case NOTIFY_CANCEL_MODE: + *function = Qcancel_mode_internal; + *object = Qnil; + break; + + default: + ABORT (); + } + } + case scrollbar_event: + { + *function = Fevent_property (event, Qsubtype); + *object = XEVENT_CHANNEL (event); + + switch (XEVENT_SCROLLBAR_TYPE (event)) + { + case SCROLLBAR_PAGE_UP: + case SCROLLBAR_PAGE_DOWN: + case SCROLLBAR_VERTICAL_DRAG: + case SCROLLBAR_HORIZONTAL_DRAG: + *object = Fcons (*object, XEVENT_SCROLLBAR_VALUE (event)); + break; + + default: + break; + } + } + + default: + ABORT (); + } } DEFUN ("event-function", Fevent_function, 1, 1, 0, /* Return the callback function of EVENT. -EVENT should be a timeout, misc-user, or eval event. +EVENT should be a timeout or eval event. +NOTE: For compatibility reasons, this also accepts activate, notify, and +scrollbar events. You should not use this in new code; instead, +use `event-callback' and/or `event-subtype'. */ (event)) { ＠＠ -2430,10 +2989,17 ＠＠ { case timeout_event: return XEVENT_TIMEOUT_FUNCTION (event); - case misc_user_event: - return XEVENT_MISC_USER_FUNCTION (event); case eval_event: return XEVENT_EVAL_FUNCTION (event); + case activate_event: + case notify_event: + case scrollbar_event: + { + Lisp_Object fun, obj; + event_function_and_object (event, &fun, &obj); + return fun; + } + default: event = wrong_type_argument (intern ("timeout-or-eval-event-p"), event); goto again; ＠＠ -2442,7 +3008,10 ＠＠ DEFUN ("event-object", Fevent_object, 1, 1, 0, /* Return the callback function argument of EVENT. -EVENT should be a timeout, misc-user, or eval event. +EVENT should be a timeout or eval event. +NOTE: For compatibility reasons, this also accepts activate, notify, and +scrollbar events. You should not use this in new code; instead, +use `event-callback' and/or `event-subtype'. */ (event)) { ＠＠ -2452,16 +3021,134 ＠＠ { case timeout_event: return XEVENT_TIMEOUT_OBJECT (event); - case misc_user_event: - return XEVENT_MISC_USER_OBJECT (event); case eval_event: return XEVENT_EVAL_OBJECT (event); + case activate_event: + case notify_event: + case scrollbar_event: + { + Lisp_Object fun, obj; + event_function_and_object (event, &fun, &obj); + return obj; + } default: event = wrong_type_argument (intern ("timeout-or-eval-event-p"), event); goto again; } } +/* This is a bit evil, but avoids lots of code duplication */ + +#define FROB_ALL_PROPERTIES \ + case process_event: \ + FROB (Qprocess, EVENT_PROCESS_PROCESS (e)); \ + break; \ + \ + case timeout_event: \ + FROB (Qobject, Fevent_object (event)); \ + FROB (Qfunction, Fevent_function (event)); \ + FROB (Qid, make_int (EVENT_TIMEOUT_ID_NUMBER (e))); \ + break; \ + \ + case key_press_event: \ + FROB (Qmodifiers, Fevent_modifiers (event)); \ + FROB (Qkey, XEVENT_KEY_KEYSYM (event)); \ + break; \ + \ + case button_press_event: \ + case button_release_event: \ + FROB (Qy, Fevent_y_pixel (event)); \ + FROB (Qx, Fevent_x_pixel (event)); \ + FROB (Qmodifiers, Fevent_modifiers (event)); \ + FROB (Qbutton, make_int (XEVENT_BUTTON_BUTTON (event))); \ + break; \ + \ + case pointer_motion_event: \ + FROB (Qmodifiers, Fevent_modifiers (event)); \ + FROB (Qy, Fevent_y_pixel (event)); \ + FROB (Qx, Fevent_x_pixel (event)); \ + break; \ + \ + case activate_event: \ + FROB (Qcallback, EVENT_ACTIVATE_CALLBACK (e)); \ + FROB (Qtext, EVENT_ACTIVATE_TEXT (e)); \ + FROB (Qsubtype, \ + event_subtype_to_symbol (activate_event, \ + EVENT_ACTIVATE_TYPE (e))); \ + break; \ + \ + case notify_event: \ + FROB (Qsubtype, \ + event_subtype_to_symbol (notify_event, \ + EVENT_NOTIFY_TYPE (e))); \ + break; \ + \ + case scrollbar_event: \ + FROB (Qscrollbar_value, EVENT_SCROLLBAR_VALUE (e)); \ + FROB (Qsubtype, \ + event_subtype_to_symbol (scrollbar_event, \ + EVENT_SCROLLBAR_TYPE (e))); \ + break; \ + \ + case drop_event: \ + FROB (Qdrop_data_type, XEVENT_DROP_DATA_TYPE (event)); \ + FROB (Qdrop_data, XEVENT_DROP_DATA (event)); \ + FROB (Qy, Fevent_y_pixel (event)); \ + FROB (Qx, Fevent_x_pixel (event)); \ + FROB (Qmodifiers, Fevent_modifiers (event)); \ + FROB (Qbutton, make_int (XEVENT_DROP_BUTTON (event))); \ + break; \ + \ + case eval_event: \ + FROB (Qobject, Fevent_object (event)); \ + FROB (Qfunction, Fevent_function (event)); \ + break; \ + \ + case magic_eval_event: \ + case magic_event: \ + break + + +static Lisp_Object +event_property_1 (Lisp_Object event, Lisp_Object prop, int nobad) +{ + Lisp_Event *e; + + CHECK_LIVE_EVENT (event); + e = XEVENT (event); + +#define FROB(sym, val) if (EQ (prop, sym)) return val + + FROB (Qtimestamp, Fevent_timestamp (event)); + + switch (e->event_type) + { + default: ABORT (); + + FROB_ALL_PROPERTIES; + + case empty_event: + goto badprop; + } + + FROB (Qchannel, XEVENT_CHANNEL (event)); + + badprop: + if (nobad) + invalid_argument_2 ("Invalid property for event type", prop, + Fevent_type (event)); + return Qunbound; +#undef FROB +} + +DEFUN ("event-property", Fevent_property, 2, 2, 0, /* +Return property PROP of EVENT. +*/ + (event, prop)) +{ + return event_property_1 (event, prop, 1); +} + DEFUN ("event-properties", Fevent_properties, 1, 1, 0, /* Return a list of all of the properties of EVENT. This is in the form of a property list (alternating keyword/value pairs). ＠＠ -2476,67 +3163,22 ＠＠ e = XEVENT (event); GCPRO1 (props); - props = cons3 (Qtimestamp, Fevent_timestamp (event), props); +#define FROB(sym, val) props = cons3 (sym, val, props) + FROB (Qtimestamp, Fevent_timestamp (event)); switch (EVENT_TYPE (e)) { default: ABORT (); - - case process_event: - props = cons3 (Qprocess, EVENT_PROCESS_PROCESS (e), props); - break; - - case timeout_event: - props = cons3 (Qobject, Fevent_object (event), props); - props = cons3 (Qfunction, Fevent_function (event), props); - props = cons3 (Qid, make_int (EVENT_TIMEOUT_ID_NUMBER (e)), props); - break; - - case key_press_event: - props = cons3 (Qmodifiers, Fevent_modifiers (event), props); - props = cons3 (Qkey, Fevent_key (event), props); - break; - case button_press_event: - case button_release_event: - props = cons3 (Qy, Fevent_y_pixel (event), props); - props = cons3 (Qx, Fevent_x_pixel (event), props); - props = cons3 (Qmodifiers, Fevent_modifiers (event), props); - props = cons3 (Qbutton, Fevent_button (event), props); - break; - - case pointer_motion_event: - props = cons3 (Qmodifiers, Fevent_modifiers (event), props); - props = cons3 (Qy, Fevent_y_pixel (event), props); - props = cons3 (Qx, Fevent_x_pixel (event), props); - break; - - case misc_user_event: - props = cons3 (Qobject, Fevent_object (event), props); - props = cons3 (Qfunction, Fevent_function (event), props); - props = cons3 (Qy, Fevent_y_pixel (event), props); - props = cons3 (Qx, Fevent_x_pixel (event), props); - props = cons3 (Qmodifiers, Fevent_modifiers (event), props); - props = cons3 (Qbutton, Fevent_button (event), props); - break; - - case eval_event: - props = cons3 (Qobject, Fevent_object (event), props); - props = cons3 (Qfunction, Fevent_function (event), props); - break; + FROB_ALL_PROPERTIES; - case magic_eval_event: - case magic_event: - break; - case empty_event: RETURN_UNGCPRO (Qnil); - break; } - props = cons3 (Qchannel, Fevent_channel (event), props); + props = cons3 (Qchannel, XEVENT_CHANNEL (event), props); UNGCPRO; - +#undef FROB return props; } ＠＠ -2556,11 +3198,16 ＠＠ INIT_LRECORD_IMPLEMENTATION (process_data); INIT_LRECORD_IMPLEMENTATION (timeout_data); INIT_LRECORD_IMPLEMENTATION (eval_data); - INIT_LRECORD_IMPLEMENTATION (misc_user_data); + INIT_LRECORD_IMPLEMENTATION (activate_data); + INIT_LRECORD_IMPLEMENTATION (scrollbar_data); + INIT_LRECORD_IMPLEMENTATION (drop_data); + INIT_LRECORD_IMPLEMENTATION (notify_data); INIT_LRECORD_IMPLEMENTATION (magic_eval_data); INIT_LRECORD_IMPLEMENTATION (magic_data); #endif /* EVENT_DATA_AS_OBJECTS */ + DEFSUBR (Fuser_event_p); + DEFSUBR (Fcommand_event_p); DEFSUBR (Fcharacter_to_event); DEFSUBR (Fevent_to_character); ＠＠ -2570,12 +3217,11 ＠＠ DEFSUBR (Feventp); DEFSUBR (Fevent_live_p); DEFSUBR (Fevent_type); + DEFSUBR (Fevent_property); DEFSUBR (Fevent_properties); DEFSUBR (Fevent_timestamp); DEFSUBR (Fevent_timestamp_lessp); - DEFSUBR (Fevent_key); - DEFSUBR (Fevent_button); DEFSUBR (Fevent_modifier_bits); DEFSUBR (Fevent_modifiers); DEFSUBR (Fevent_x_pixel); ＠＠ -2587,7 +3233,7 ＠＠ DEFSUBR (Fevent_over_border_p); DEFSUBR (Fevent_over_toolbar_p); DEFSUBR (Fevent_over_vertical_divider_p); - DEFSUBR (Fevent_channel); + DEFSUBR (Fevent_console); DEFSUBR (Fevent_window); DEFSUBR (Fevent_point); DEFSUBR (Fevent_closest_point); ＠＠ -2599,7 +3245,6 ＠＠ DEFSUBR (Fevent_glyph_x_pixel); DEFSUBR (Fevent_glyph_y_pixel); DEFSUBR (Fevent_toolbar_button); - DEFSUBR (Fevent_process); DEFSUBR (Fevent_function); DEFSUBR (Fevent_object); ＠＠ -2612,7 +3257,6 ＠＠ DEFSYMBOL (Qkey_press); DEFSYMBOL (Qbutton_press); DEFSYMBOL (Qbutton_release); - DEFSYMBOL (Qmisc_user); DEFSYMBOL (Qascii_character); defsymbol (&QKbackspace, "backspace"); ＠＠ -2622,6 +3266,33 ＠＠ defsymbol (&QKescape, "escape"); defsymbol (&QKspace, "space"); defsymbol (&QKdelete, "delete"); + + DEFSYMBOL (Qdrop_data); + DEFSYMBOL (Qdrop_data_type); + DEFSYMBOL (Qscrollbar_value); + + DEFSYMBOL (Qactivate_menu_selection); + DEFSYMBOL (Qactivate_toolbar_selection); + DEFSYMBOL (Qactivate_dialog_box_selection); + DEFSYMBOL (Qactivate_widget_action); + DEFSYMBOL (Qscrollbar_page_up); + DEFSYMBOL (Qscrollbar_page_down); + DEFSYMBOL (Qscrollbar_page_left); + DEFSYMBOL (Qscrollbar_page_right); + DEFSYMBOL (Qscrollbar_line_up); + DEFSYMBOL (Qscrollbar_line_down); + DEFSYMBOL (Qscrollbar_char_left); + DEFSYMBOL (Qscrollbar_char_right); + DEFSYMBOL (Qscrollbar_to_top); + DEFSYMBOL (Qscrollbar_to_bottom); + DEFSYMBOL (Qscrollbar_to_left); + DEFSYMBOL (Qscrollbar_to_right); + DEFSYMBOL (Qscrollbar_vertical_drag); + DEFSYMBOL (Qscrollbar_horizontal_drag); + DEFSYMBOL (Qnotify_no_menu_selection); + DEFSYMBOL (Qnotify_dialog_box_cancelled); + DEFSYMBOL (Qnotify_close_frame); + DEFSYMBOL (Qnotify_cancel_mode); } 1.39.6.1 +305 -110 XEmacs/xemacs/src/events.h Index: events.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/events.h,v retrieving revision 1.39 retrieving revision 1.39.6.1 diff -u -r1.39 -r1.39.6.1 --- events.h 2004/11/04 23:06:27 1.39 +++ events.h 2005/02/16 00:43:07 1.39.6.1 ＠＠ -1,7 +1,7 ＠＠ /* Definitions for the new event model; created 16-jul-91 by Jamie Zawinski Copyright (C) 1991, 1992, 1993 Free Software Foundation, Inc. - Copyright (C) 1995, 1996, 2002 Ben Wing. + Copyright (C) 1995, 1996, 2002, 2003n Ben Wing. This file is part of XEmacs. ＠＠ -44,34 +44,34 ＠＠ struct event_stream { int (*event_pending_p) (int); - void (*next_event_cb) (Lisp_Event *); - void (*handle_magic_event_cb) (Lisp_Event *); - void (*format_magic_event_cb) (Lisp_Event *, Lisp_Object pstream); - int (*compare_magic_event_cb) (Lisp_Event *, Lisp_Event *); - Hashcode (*hash_magic_event_cb)(Lisp_Event *); - int (*add_timeout_cb) (EMACS_TIME); - void (*remove_timeout_cb) (int); - void (*select_console_cb) (struct console *); - void (*unselect_console_cb) (struct console *); - void (*select_process_cb) (Lisp_Process *, int doin, int doerr); - void (*unselect_process_cb) (Lisp_Process *, int doin, int doerr); - void (*drain_queue_cb) (void); - void (*force_event_pending_cb)(struct frame* f); - void (*create_io_streams_cb) (void* /* inhandle*/, void* /*outhandle*/ , + void (*next_event) (Lisp_Event *); + void (*handle_magic_event) (Lisp_Event *); + void (*format_magic_event) (Lisp_Event *, Lisp_Object pstream); + int (*compare_magic_event) (Lisp_Event *, Lisp_Event *); + Hashcode (*hash_magic_event) (Lisp_Event *); + int (*add_timeout) (EMACS_TIME); + void (*remove_timeout) (int); + void (*select_console) (struct console *); + void (*unselect_console) (struct console *); + void (*select_process) (Lisp_Process *, int doin, int doerr); + void (*unselect_process) (Lisp_Process *, int doin, int doerr); + void (*drain_queue) (void); + void (*force_event_pending) (struct frame* f); + void (*create_io_streams) (void* /* inhandle*/, void* /*outhandle*/ , void * /* errhandle*/, Lisp_Object* /* instream */, Lisp_Object* /* outstream */, Lisp_Object* /* errstream */, USID * /* in_usid */, USID * /* err_usid */, int /* flags */); - void (*delete_io_streams_cb) (Lisp_Object /* instream */, + void (*delete_io_streams) (Lisp_Object /* instream */, Lisp_Object /* outstream */, Lisp_Object /* errstream */, USID * /* in_usid */, USID * /* err_usid */); - int (*current_event_timestamp_cb) (struct console *); + int (*current_event_timestamp)(struct console *); }; -/* Flags for create_io_streams_cb() FLAGS parameter */ +/* Flags for create_io_streams() FLAGS parameter */ #define STREAM_PTY_FLUSHING 0x0001 #define STREAM_NETWORK_CONNECTION 0x0002 ＠＠ -89,7 +89,7 ＠＠ do { (e)->event.downtype.field = (val); } while (0) #endif -typedef enum emacs_event_type +typedef enum lisp_event_type { empty_event, key_press_event, ＠＠ -101,10 +101,14 ＠＠ magic_event, magic_eval_event, eval_event, - misc_user_event, + activate_event, + scrollbar_event, + drop_event, + notify_event, dead_event -} emacs_event_type; +} lisp_event_type; + #define first_event_type empty_event #define last_event_type dead_event ＠＠ -319,12 +323,12 ＠＠ { /* interval_id The ID returned when the associated call to - add_timeout_cb() was made + add_timeout() was made ------ the rest of the fields are filled in by XEmacs ----- id_number The XEmacs timeout ID for this timeout (more than one timeout event can have the same value here, since XEmacs timeouts, as opposed to - add_timeout_cb() timeouts, can resignal + add_timeout() timeouts, can resignal themselves) function An elisp function to call when this timeout is processed. ＠＠ -419,90 +423,232 ＠＠ SET_EVENT_FOO_BAR (e, EVAL, eval, object, val) #define XSET_EVENT_EVAL_OBJECT(e, val) \ SET_EVENT_EVAL_OBJECT (XEVENT (e), val) + +/* The former "misc-user" event has been split into various different + events: + + activate An item in a menu, toolbar or dialog box was selected; + a widget button was pressed; etc. + scrollbar Scrollbar action -- move, click, etc. + drop A dragged item was dropped into an XEmacs frame. + notify Miscellaneous notifications from the window system, e.g. + the user clicked the close button to close a frame, + cancelled a selection in progress, cancelled a menu or dialog + box, etc. +*/ -struct Lisp_Misc_User_Data +enum activate_event_type { -/* #### The misc-user type is serious junk. It should be separated - out into different events. There's no reason to create - sub-subtypes of events. + ACTIVATE_MENU_SELECTION, + ACTIVATE_TOOLBAR_SELECTION, + ACTIVATE_DIALOG_BOX_SELECTION, + ACTIVATE_WIDGET_ACTION, +}; - function An elisp function to call with this event object. - object Argument of function. +struct Lisp_Activate_Data +{ +#ifdef EVENT_DATA_AS_OBJECTS + struct lrecord_header lheader; +#endif /* EVENT_DATA_AS_OBJECTS */ + /* + type The type of action that occurred (menu selection, + toolbar selection, etc.). + text The text of the item. + callback Callback function of item. + */ + enum activate_event_type type; + Lisp_Object text; + Lisp_Object callback; +}; +typedef struct Lisp_Activate_Data Lisp_Activate_Data; + +#ifdef EVENT_DATA_AS_OBJECTS +DECLARE_LRECORD (activate_data, Lisp_Activate_Data); +#define XACTIVATE_DATA(x) XRECORD (x, activate_data, Lisp_Activate_Data) +#define wrap_activate_data(p) wrap_record(p, activate_data) +#define ACTIVATE_DATAP(x) RECORDP (x, activate_data) +#define CHECK_ACTIVATE_DATA(x) CHECK_RECORD (x, activate_data) +#define CONCHECK_ACTIVATE_DATA(x) CONCHECK_RECORD (x, activate_data) +#endif /* EVENT_DATA_AS_OBJECTS */ + +#define EVENT_ACTIVATE_TYPE(e) EVENT_FOO_BAR (e, ACTIVATE, activate, type) +#define XEVENT_ACTIVATE_TYPE(e) EVENT_ACTIVATE_TYPE (XEVENT (e)) +#define SET_EVENT_ACTIVATE_TYPE(e, val) \ + SET_EVENT_FOO_BAR (e, ACTIVATE, activate, type, val) +#define XSET_EVENT_ACTIVATE_TYPE(e, val) \ + SET_EVENT_ACTIVATE_TYPE (XEVENT (e), val) + +#define EVENT_ACTIVATE_TEXT(e) EVENT_FOO_BAR (e, ACTIVATE, activate, text) +#define XEVENT_ACTIVATE_TEXT(e) EVENT_ACTIVATE_TEXT (XEVENT (e)) +#define SET_EVENT_ACTIVATE_TEXT(e, val) \ + SET_EVENT_FOO_BAR (e, ACTIVATE, activate, text, val) +#define XSET_EVENT_ACTIVATE_TEXT(e, val) \ + SET_EVENT_ACTIVATE_TEXT (XEVENT (e), val) + +#define EVENT_ACTIVATE_CALLBACK(e) EVENT_FOO_BAR (e, ACTIVATE, activate, callback) +#define XEVENT_ACTIVATE_CALLBACK(e) EVENT_ACTIVATE_CALLBACK (XEVENT (e)) +#define SET_EVENT_ACTIVATE_CALLBACK(e, val) \ + SET_EVENT_FOO_BAR (e, ACTIVATE, activate, callback, val) +#define XSET_EVENT_ACTIVATE_CALLBACK(e, val) \ + SET_EVENT_ACTIVATE_CALLBACK (XEVENT (e), val) + +enum scrollbar_event_type +{ + SCROLLBAR_PAGE_UP, + SCROLLBAR_PAGE_DOWN, + SCROLLBAR_PAGE_LEFT, + SCROLLBAR_PAGE_RIGHT, + SCROLLBAR_LINE_UP, + SCROLLBAR_LINE_DOWN, + SCROLLBAR_CHAR_LEFT, + SCROLLBAR_CHAR_RIGHT, + SCROLLBAR_TO_TOP, + SCROLLBAR_TO_BOTTOM, + SCROLLBAR_TO_LEFT, + SCROLLBAR_TO_RIGHT, + SCROLLBAR_VERTICAL_DRAG, + SCROLLBAR_HORIZONTAL_DRAG, +}; + +struct Lisp_Scrollbar_Data +{ +#ifdef EVENT_DATA_AS_OBJECTS + struct lrecord_header lheader; +#endif /* EVENT_DATA_AS_OBJECTS */ + enum scrollbar_event_type type; + Lisp_Object value; /* for dragging etc? */ +}; +typedef struct Lisp_Scrollbar_Data Lisp_Scrollbar_Data; + +#ifdef EVENT_DATA_AS_OBJECTS +DECLARE_LRECORD (scrollbar_data, Lisp_Scrollbar_Data); +#define XSCROLLBAR_DATA(x) XRECORD (x, scrollbar_data, Lisp_Scrollbar_Data) +#define wrap_scrollbar_data(p) wrap_record(p, scrollbar_data) +#define SCROLLBAR_DATAP(x) RECORDP (x, scrollbar_data) +#define CHECK_SCROLLBAR_DATA(x) CHECK_RECORD (x, scrollbar_data) +#define CONCHECK_SCROLLBAR_DATA(x) CONCHECK_RECORD (x, scrollbar_data) +#endif /* EVENT_DATA_AS_OBJECTS */ + +#define EVENT_SCROLLBAR_TYPE(e) EVENT_FOO_BAR (e, SCROLLBAR, scrollbar, type) +#define XEVENT_SCROLLBAR_TYPE(e) EVENT_SCROLLBAR_TYPE (XEVENT (e)) +#define SET_EVENT_SCROLLBAR_TYPE(e, val) \ + SET_EVENT_FOO_BAR (e, SCROLLBAR, scrollbar, type, val) +#define XSET_EVENT_SCROLLBAR_TYPE(e, val) \ + SET_EVENT_SCROLLBAR_TYPE (XEVENT (e), val) + +#define EVENT_SCROLLBAR_VALUE(e) EVENT_FOO_BAR (e, SCROLLBAR, scrollbar, value) +#define XEVENT_SCROLLBAR_VALUE(e) EVENT_SCROLLBAR_VALUE (XEVENT (e)) +#define SET_EVENT_SCROLLBAR_VALUE(e, val) \ + SET_EVENT_FOO_BAR (e, SCROLLBAR, scrollbar, value, val) +#define XSET_EVENT_SCROLLBAR_VALUE(e, val) \ + SET_EVENT_SCROLLBAR_VALUE (XEVENT (e), val) + +struct Lisp_Drop_Data +{ +#ifdef EVENT_DATA_AS_OBJECTS + struct lrecord_header lheader; +#endif /* EVENT_DATA_AS_OBJECTS */ +/* + data_type Type of data. + data Data. button What button went down or up. modifiers Bucky-bits on that button: shift, control, meta, etc. x, y Where it was at the button-state-change (in pixels). - This is similar to an eval_event, except that it is - generated by user actions: selections in the - menubar, scrollbar actions, or drag and drop actions. - It is a "command" event, like key and mouse presses - (and unlike mouse motion, process output, and enter - and leave window hooks). In many ways, eval_events - are not the same as keypresses or misc_user_events. - The button, modifiers, x, and y parts are only used - by the XEmacs Drag'n'Drop system. Don't depend on their - values for other types of misc_user_events. */ -#ifdef EVENT_DATA_AS_OBJECTS - struct lrecord_header lheader; -#endif /* EVENT_DATA_AS_OBJECTS */ - Lisp_Object function; - Lisp_Object object; + Lisp_Object data_type; + Lisp_Object data; int button; int modifiers; int x, y; +}; +typedef struct Lisp_Drop_Data Lisp_Drop_Data; + +#ifdef EVENT_DATA_AS_OBJECTS +DECLARE_LRECORD (drop_data, Lisp_Drop_Data); +#define XDROP_DATA(x) XRECORD (x, drop_data, Lisp_Drop_Data) +#define wrap_drop_data(p) wrap_record(p, drop_data) +#define DROP_DATAP(x) RECORDP (x, drop_data) +#define CHECK_DROP_DATA(x) CHECK_RECORD (x, drop_data) +#define CONCHECK_DROP_DATA(x) CONCHECK_RECORD (x, drop_data) +#endif /* EVENT_DATA_AS_OBJECTS */ + +#define EVENT_DROP_DATA_TYPE(e) EVENT_FOO_BAR (e, DROP, drop, data_type) +#define XEVENT_DROP_DATA_TYPE(e) EVENT_DROP_DATA_TYPE (XEVENT (e)) +#define SET_EVENT_DROP_DATA_TYPE(e, val) \ + SET_EVENT_FOO_BAR (e, DROP, drop, data_type, val) +#define XSET_EVENT_DROP_DATA_TYPE(e, val) \ + SET_EVENT_DROP_DATA_TYPE (XEVENT (e), val) + +#define EVENT_DROP_DATA(e) EVENT_FOO_BAR (e, DROP, drop, data) +#define XEVENT_DROP_DATA(e) EVENT_DROP_DATA (XEVENT (e)) +#define SET_EVENT_DROP_DATA(e, val) \ + SET_EVENT_FOO_BAR (e, DROP, drop, data, val) +#define XSET_EVENT_DROP_DATA(e, val) \ + SET_EVENT_DROP_DATA (XEVENT (e), val) + +#define EVENT_DROP_BUTTON(e) EVENT_FOO_BAR (e, DROP, drop, button) +#define XEVENT_DROP_BUTTON(e) EVENT_DROP_BUTTON (XEVENT (e)) +#define SET_EVENT_DROP_BUTTON(e, val) \ + SET_EVENT_FOO_BAR (e, DROP, drop, button, val) +#define XSET_EVENT_DROP_BUTTON(e, val) \ + SET_EVENT_DROP_BUTTON (XEVENT (e), val) + +#define EVENT_DROP_MODIFIERS(e) EVENT_FOO_BAR (e, DROP, drop, modifiers) +#define XEVENT_DROP_MODIFIERS(e) EVENT_DROP_MODIFIERS (XEVENT (e)) +#define SET_EVENT_DROP_MODIFIERS(e, val) \ + SET_EVENT_FOO_BAR (e, DROP, drop, modifiers, val) +#define XSET_EVENT_DROP_MODIFIERS(e, val) \ + SET_EVENT_DROP_MODIFIERS (XEVENT (e), val) + +#define EVENT_DROP_X(e) EVENT_FOO_BAR (e, DROP, drop, x) +#define XEVENT_DROP_X(e) EVENT_DROP_X (XEVENT (e)) +#define SET_EVENT_DROP_X(e, val) \ + SET_EVENT_FOO_BAR (e, DROP, drop, x, val) +#define XSET_EVENT_DROP_X(e, val) \ + SET_EVENT_DROP_X (XEVENT (e), val) + +#define EVENT_DROP_Y(e) EVENT_FOO_BAR (e, DROP, drop, y) +#define XEVENT_DROP_Y(e) EVENT_DROP_Y (XEVENT (e)) +#define SET_EVENT_DROP_Y(e, val) \ + SET_EVENT_FOO_BAR (e, DROP, drop, y, val) +#define XSET_EVENT_DROP_Y(e, val) \ + SET_EVENT_DROP_Y (XEVENT (e), val) + +enum notify_event_type +{ + NOTIFY_NO_MENU_SELECTION, + NOTIFY_DIALOG_BOX_CANCELLED, + NOTIFY_CLOSE_FRAME, + NOTIFY_CANCEL_MODE, +}; + +struct Lisp_Notify_Data +{ +#ifdef EVENT_DATA_AS_OBJECTS + struct lrecord_header lheader; +#endif /* EVENT_DATA_AS_OBJECTS */ + /* + type Type of notify. + */ + enum notify_event_type type; }; -typedef struct Lisp_Misc_User_Data Lisp_Misc_User_Data; +typedef struct Lisp_Notify_Data Lisp_Notify_Data; #ifdef EVENT_DATA_AS_OBJECTS -DECLARE_LRECORD (misc_user_data, Lisp_Misc_User_Data); -#define XMISC_USER_DATA(x) XRECORD (x, misc_user_data, Lisp_Misc_User_Data) -#define wrap_misc_user_data(p) wrap_record(p, misc_user_data) -#define MISC_USER_DATAP(x) RECORDP (x, misc_user_data) -#define CHECK_MISC_USER_DATA(x) CHECK_RECORD (x, misc_user_data) -#define CONCHECK_MISC_USER_DATA(x) CONCHECK_RECORD (x, misc_user_data) -#endif /* EVENT_DATA_AS_OBJECTS */ - -#define EVENT_MISC_USER_FUNCTION(e) EVENT_FOO_BAR (e, MISC_USER, misc_user, function) -#define XEVENT_MISC_USER_FUNCTION(e) EVENT_MISC_USER_FUNCTION (XEVENT (e)) -#define SET_EVENT_MISC_USER_FUNCTION(e, val) \ - SET_EVENT_FOO_BAR (e, MISC_USER, misc_user, function, val) -#define XSET_EVENT_MISC_USER_FUNCTION(e, val) \ - SET_EVENT_MISC_USER_FUNCTION (XEVENT (e), val) - -#define EVENT_MISC_USER_OBJECT(e) EVENT_FOO_BAR (e, MISC_USER, misc_user, object) -#define XEVENT_MISC_USER_OBJECT(e) EVENT_MISC_USER_OBJECT (XEVENT (e)) -#define SET_EVENT_MISC_USER_OBJECT(e, val) \ - SET_EVENT_FOO_BAR (e, MISC_USER, misc_user, object, val) -#define XSET_EVENT_MISC_USER_OBJECT(e, val) \ - SET_EVENT_MISC_USER_OBJECT (XEVENT (e), val) - -#define EVENT_MISC_USER_BUTTON(e) EVENT_FOO_BAR (e, MISC_USER, misc_user, button) -#define XEVENT_MISC_USER_BUTTON(e) EVENT_MISC_USER_BUTTON (XEVENT (e)) -#define SET_EVENT_MISC_USER_BUTTON(e, val) \ - SET_EVENT_FOO_BAR (e, MISC_USER, misc_user, button, val) -#define XSET_EVENT_MISC_USER_BUTTON(e, val) \ - SET_EVENT_MISC_USER_BUTTON (XEVENT (e), val) - -#define EVENT_MISC_USER_MODIFIERS(e) EVENT_FOO_BAR (e, MISC_USER, misc_user, modifiers) -#define XEVENT_MISC_USER_MODIFIERS(e) EVENT_MISC_USER_MODIFIERS (XEVENT (e)) -#define SET_EVENT_MISC_USER_MODIFIERS(e, val) \ - SET_EVENT_FOO_BAR (e, MISC_USER, misc_user, modifiers, val) -#define XSET_EVENT_MISC_USER_MODIFIERS(e, val) \ - SET_EVENT_MISC_USER_MODIFIERS (XEVENT (e), val) - -#define EVENT_MISC_USER_X(e) EVENT_FOO_BAR (e, MISC_USER, misc_user, x) -#define XEVENT_MISC_USER_X(e) EVENT_MISC_USER_X (XEVENT (e)) -#define SET_EVENT_MISC_USER_X(e, val) \ - SET_EVENT_FOO_BAR (e, MISC_USER, misc_user, x, val) -#define XSET_EVENT_MISC_USER_X(e, val) \ - SET_EVENT_MISC_USER_X (XEVENT (e), val) - -#define EVENT_MISC_USER_Y(e) EVENT_FOO_BAR (e, MISC_USER, misc_user, y) -#define XEVENT_MISC_USER_Y(e) EVENT_MISC_USER_Y (XEVENT (e)) -#define SET_EVENT_MISC_USER_Y(e, val) \ - SET_EVENT_FOO_BAR (e, MISC_USER, misc_user, y, val) -#define XSET_EVENT_MISC_USER_Y(e, val) \ - SET_EVENT_MISC_USER_Y (XEVENT (e), val) +DECLARE_LRECORD (notify_data, Lisp_Notify_Data); +#define XNOTIFY_DATA(x) XRECORD (x, notify_data, Lisp_Notify_Data) +#define wrap_notify_data(p) wrap_record(p, notify_data) +#define NOTIFY_DATAP(x) RECORDP (x, notify_data) +#define CHECK_NOTIFY_DATA(x) CHECK_RECORD (x, notify_data) +#define CONCHECK_NOTIFY_DATA(x) CONCHECK_RECORD (x, notify_data) +#endif /* EVENT_DATA_AS_OBJECTS */ + +#define EVENT_NOTIFY_TYPE(e) EVENT_FOO_BAR (e, NOTIFY, notify, type) +#define XEVENT_NOTIFY_TYPE(e) EVENT_NOTIFY_TYPE (XEVENT (e)) +#define SET_EVENT_NOTIFY_TYPE(e, val) \ + SET_EVENT_FOO_BAR (e, NOTIFY, notify, type, val) +#define XSET_EVENT_NOTIFY_TYPE(e, val) \ + SET_EVENT_NOTIFY_TYPE (XEVENT (e), val) struct Lisp_Magic_Eval_Data { ＠＠ -665,13 +811,13 ＠＠ { /* header->next (aka XEVENT_NEXT ()) is used as follows: - For dead events, this is the next dead one. - - For events on the command_event_queue, the next one on the queue. + - For events on the deferred_event_queue, the next one on the queue. - Likewise for events chained in the command builder. - Otherwise it's Qnil. */ struct lrecord_header lheader; Lisp_Object next; - emacs_event_type event_type; + lisp_event_type event_type; /* Where this event occurred on. This will be a frame, device, console, or nil, depending on the event type. It is important ＠＠ -694,11 +840,18 ＠＠ -- for timer, process, magic-eval, and eval events, channel will be nil. + + -- for activate events, channel will be a frame, or (for widget events) + an image instance. + + -- for scrollbar events, channel will be a window. - -- for misc-user events, channel will be a frame. + -- for drop events, channel will be a frame. + -- for notify events, channel will be frame. + -- for magic events, channel will be a frame (usually) or a - device. */ + device, or nil. */ Lisp_Object channel; /* When this event occurred -- if not known, this is made up. #### ＠＠ -718,8 +871,11 ＠＠ Lisp_Motion_Data motion; Lisp_Process_Data process; Lisp_Timeout_Data timeout; - Lisp_Eval_Data eval; /* misc_user_event no longer uses this */ - Lisp_Misc_User_Data misc_user;/* because it needs position information */ + Lisp_Eval_Data eval; + Lisp_Activate_Data activate; + Lisp_Scrollbar_Data scrollbar; + Lisp_Drop_Data drop; + Lisp_Notify_Data notify; Lisp_Magic_Data magic; Lisp_Magic_Eval_Data magic_eval; } event; ＠＠ -736,7 +892,7 ＠＠ DECLARE_LRECORD (command_builder, struct command_builder); #define EVENT_CHANNEL(a) ((a)->channel) -#define XEVENT_CHANNEL(ev) (XEVENT (ev)->channel) +#define XEVENT_CHANNEL(a) EVENT_CHANNEL (XEVENT (a)) #define EVENT_TYPE(a) ((a)->event_type) #define XEVENT_TYPE(a) (XEVENT (a)->event_type) #define EVENT_NEXT(a) ((a)->next) ＠＠ -768,7 +924,7 ＠＠ DECLARE_INLINE_HEADER ( void -set_event_type (struct Lisp_Event *event, emacs_event_type t) +set_event_type (struct Lisp_Event *event, lisp_event_type t) ) { #ifdef EVENT_DATA_AS_OBJECTS ＠＠ -798,9 +954,18 ＠＠ break; case eval_event: free_eval_data (event->event_data); + break; + case activate_event: + free_activate_data (event->event_data); + break; + case scrollbar_event: + free_scrollbar_data (event->event_data); + break; + case drop_event: + free_drop_data (event->event_data); break; - case misc_user_event: - free_misc_user_data (event->event_data); + case notify_event: + free_notify_data (event->event_data); break; default: break; ＠＠ -837,9 +1002,18 ＠＠ case eval_event: event->event_data = make_eval_data (); break; - case misc_user_event: - event->event_data = make_misc_user_data (); + case activate_event: + event->event_data = make_activate_data (); break; + case scrollbar_event: + event->event_data = make_scrollbar_data (); + break; + case drop_event: + event->event_data = make_drop_data (); + break; + case notify_event: + event->event_data = make_notify_data (); + break; default: event->event_data = Qnil; break; ＠＠ -910,8 +1084,10 ＠＠ #define KEYSYM(x) (intern (x)) /* from events.c */ -void format_event_object (Eistring *buf, Lisp_Object event, int brief); -/*void format_event_data_object (Eistring *buf, Lisp_Object data, int brief);*/ +void format_event_object (Eistring *buf, Lisp_Object event, + int from_print_event); +/*void format_event_data_object (Eistring *buf, Lisp_Object data, + int from_print_event);*/ void character_to_event (Ichar c, Lisp_Event *event, struct console *con, int use_console_meta_flag, ＠＠ -941,12 +1117,12 ＠＠ void nth_of_key_sequence_as_event (Lisp_Object seq, int n, Lisp_Object event); Lisp_Object key_sequence_to_event_chain (Lisp_Object seq); -/* True if this is a non-internal event - (keyboard press, menu, scrollbar, mouse button) */ +int user_event_p (Lisp_Object event); int command_event_p (Lisp_Object event); void define_self_inserting_symbol (Lisp_Object, Lisp_Object); Ichar event_to_character (Lisp_Object, int, int, int); struct console *event_console_or_selected (Lisp_Object event); +int current_time_from_event_channel_or_else (Lisp_Object channel); void upshift_event (Lisp_Object event); void downshift_event (Lisp_Object event); int event_upshifted_p (Lisp_Object event); ＠＠ -982,6 +1158,18 ＠＠ void *barg, int flags); void event_stream_drain_queue (void); void event_stream_quit_p (void); +int event_stream_current_event_timestamp (struct console *c); + +void enqueue_activate_event (enum activate_event_type type, + Lisp_Object channel, Lisp_Object name, + Lisp_Object callback); +void enqueue_notify_event (enum notify_event_type type, Lisp_Object frame); +void enqueue_scrollbar_event (enum scrollbar_event_type type, + Lisp_Object window, Lisp_Object value); +void enqueue_drop_event (Lisp_Object channel, Lisp_Object data_type, + Lisp_Object data, int button, int modifiers, + int x, int y); + void run_pre_idle_hook (void); struct low_level_timeout ＠＠ -1073,6 +1261,13 ＠＠ subprocesses with no event loops? */ /* Beware: this evil macro evaluates its arg many times */ #define FD_TO_USID(fd) ((fd)==0 ? (USID)999999 : ((fd)<0 ? USID_DONTHASH : (USID)(fd))) + +/* Declare that the event stream of type TYPE has method M; the name of the + method is generated from the arguments. Used in initialization + routines. */ + +#define EVENT_STREAM_HAS_METHOD(type, m) \ + (type##_event_stream->m = type##_##m) /* Define this if you want the tty event stream to be used when the first console is tty, even if HAVE_X_WINDOWS is defined */ 1.1.10.1 +3 -0 XEmacs/xemacs/src/extents-impl.h Index: extents-impl.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/extents-impl.h,v retrieving revision 1.1 retrieving revision 1.1.10.1 diff -u -r1.1 -r1.1.10.1 --- extents-impl.h 2002/06/20 21:18:30 1.1 +++ extents-impl.h 2005/02/16 00:43:07 1.1.10.1 ＠＠ -234,6 +234,9 ＠＠ #define extent_face(e) extent_normal_field (e, face) #define extent_begin_glyph_layout(e) ((enum glyph_layout) extent_normal_field (e, begin_glyph_layout)) #define extent_end_glyph_layout(e) ((enum glyph_layout) extent_normal_field (e, end_glyph_layout)) +#define extent_glyph_layout(e, side) \ + ((side) == LEFT_GLYPHS ? extent_begin_glyph_layout (e) : \ + extent_end_glyph_layout (e)) #define extent_start_open_p(e) extent_normal_field (e, start_open) #define extent_end_open_p(e) extent_normal_field (e, end_open) #define extent_unique_p(e) extent_normal_field (e, unique) 1.56.4.1 +154 -157 XEmacs/xemacs/src/extents.c Index: extents.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/extents.c,v retrieving revision 1.56 retrieving revision 1.56.4.1 diff -u -r1.56 -r1.56.4.1 --- extents.c 2005/02/03 16:14:06 1.56 +++ extents.c 2005/02/16 00:43:08 1.56.4.1 ＠＠ -405,12 +405,12 ＠＠ /* Similar for Bytebpos's and start/end indices. */ -#define buffer_or_string_bytexpos_to_startind(obj, ind, start_open) \ - memxpos_to_startind (buffer_or_string_bytexpos_to_memxpos (obj, ind), \ +#define textobj_bytexpos_to_startind(obj, ind, start_open) \ + memxpos_to_startind (textobj_bytexpos_to_memxpos (obj, ind), \ start_open) -#define buffer_or_string_bytexpos_to_endind(obj, ind, end_open) \ - memxpos_to_endind (buffer_or_string_bytexpos_to_memxpos (obj, ind), \ +#define textobj_bytexpos_to_endind(obj, ind, end_open) \ + memxpos_to_endind (textobj_bytexpos_to_memxpos (obj, ind), \ end_open) /* ------------------------------- */ ＠＠ -470,15 +470,6 ＠＠ static Lisp_Object canonicalize_extent_property (Lisp_Object prop, Lisp_Object value); -typedef struct -{ - Lisp_Object key, value; -} Lisp_Object_pair; -typedef struct -{ - Dynarr_declare (Lisp_Object_pair); -} Lisp_Object_pair_dynarr; - static void extent_properties (EXTENT e, Lisp_Object_pair_dynarr *props); Lisp_Object Vextent_face_memoize_hash_table; ＠＠ -1204,7 +1195,7 ＠＠ /* ------------------------------- */ static Lisp_Object -decode_buffer_or_string (Lisp_Object object) +decode_extent_object (Lisp_Object object) { if (NILP (object)) object = wrap_buffer (current_buffer); ＠＠ -1234,7 +1225,7 ＠＠ This may be 0 for a string. */ static struct extent_info * -buffer_or_string_extent_info (Lisp_Object object) +extent_object_extent_info (Lisp_Object object) { if (STRINGP (object)) { ＠＠ -1253,9 +1244,9 ＠＠ 0 for a string. */ static Extent_List * -buffer_or_string_extent_list (Lisp_Object object) +extent_object_extent_list (Lisp_Object object) { - struct extent_info *info = buffer_or_string_extent_info (object); + struct extent_info *info = extent_object_extent_info (object); if (!info) return 0; ＠＠ -1266,9 +1257,9 ＠＠ create it. */ static struct extent_info * -buffer_or_string_extent_info_force (Lisp_Object object) +extent_object_extent_info_force (Lisp_Object object) { - struct extent_info *info = buffer_or_string_extent_info (object); + struct extent_info *info = extent_object_extent_info (object); if (!info) { ＠＠ -1292,7 +1283,7 ＠＠ void detach_all_extents (Lisp_Object object) { - struct extent_info *data = buffer_or_string_extent_info (object); + struct extent_info *data = extent_object_extent_info (object); if (data) { ＠＠ -1340,7 +1331,7 ＠＠ case the only extents that can refer to this buffer are detached ones). */ -#define extent_extent_list(e) buffer_or_string_extent_list (extent_object (e)) +#define extent_extent_list(e) extent_object_extent_list (extent_object (e)) /* ------------------------------- */ /* stack of extents */ ＠＠ -1355,7 +1346,7 ＠＠ { int i; int endp; - Extent_List *el = buffer_or_string_extent_list (object); + Extent_List *el = extent_object_extent_list (object); struct buffer *buf = 0; if (!el) ＠＠ -1385,18 +1376,18 ＠＠ #endif static Stack_Of_Extents * -buffer_or_string_stack_of_extents (Lisp_Object object) +extent_object_stack_of_extents (Lisp_Object object) { - struct extent_info *info = buffer_or_string_extent_info (object); + struct extent_info *info = extent_object_extent_info (object); if (!info) return 0; return info->soe; } static Stack_Of_Extents * -buffer_or_string_stack_of_extents_force (Lisp_Object object) +extent_object_stack_of_extents_force (Lisp_Object object) { - struct extent_info *info = buffer_or_string_extent_info_force (object); + struct extent_info *info = extent_object_extent_info_force (object); if (!info->soe) info->soe = allocate_soe (); return info->soe; ＠＠ -1425,7 +1416,7 ＠＠ soe_dump (Lisp_Object obj) { int i; - Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj); + Stack_Of_Extents *soe = extent_object_stack_of_extents (obj); Extent_List *sel; int endp; ＠＠ -1437,7 +1428,7 ＠＠ sel = soe->extents; printf ("SOE pos is %d (memxpos %d)\n", soe->pos < 0 ? soe->pos : - buffer_or_string_memxpos_to_bytexpos (obj, soe->pos), + textobj_memxpos_to_bytexpos (obj, soe->pos), soe->pos); for (endp = 0; endp < 2; endp++) { ＠＠ -1460,7 +1451,7 ＠＠ static void soe_insert (Lisp_Object obj, EXTENT extent) { - Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj); + Stack_Of_Extents *soe = extent_object_stack_of_extents (obj); #ifdef SOE_DEBUG printf ("Inserting into SOE: "); ＠＠ -1487,7 +1478,7 ＠＠ static void soe_delete (Lisp_Object obj, EXTENT extent) { - Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj); + Stack_Of_Extents *soe = extent_object_stack_of_extents (obj); #ifdef SOE_DEBUG printf ("Deleting from SOE: "); ＠＠ -1514,10 +1505,10 ＠＠ static void soe_move (Lisp_Object obj, Memxpos pos) { - Stack_Of_Extents *soe = buffer_or_string_stack_of_extents_force (obj); + Stack_Of_Extents *soe = extent_object_stack_of_extents_force (obj); Extent_List *sel = soe->extents; int numsoe = extent_list_num_els (sel); - Extent_List *bel = buffer_or_string_extent_list (obj); + Extent_List *bel = extent_object_extent_list (obj); int direction; int endp; ＠＠ -1528,8 +1519,8 ＠＠ #ifdef SOE_DEBUG printf ("Moving SOE from %d (memxpos %d) to %d (memxpos %d)\n", soe->pos < 0 ? soe->pos : - buffer_or_string_memxpos_to_bytexpos (obj, soe->pos), soe->pos, - buffer_or_string_memxpos_to_bytexpos (obj, pos), pos); + textobj_memxpos_to_bytexpos (obj, soe->pos), soe->pos, + textobj_memxpos_to_bytexpos (obj, pos), pos); #endif if (soe->pos < pos) { ＠＠ -1638,7 +1629,7 ＠＠ static void soe_invalidate (Lisp_Object obj) { - Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj); + Stack_Of_Extents *soe = extent_object_stack_of_extents (obj); if (soe) { ＠＠ -1680,7 +1671,7 ＠＠ { Memxpos i = endp ? extent_end (extent) : extent_start (extent); Lisp_Object obj = extent_object (extent); - return buffer_or_string_memxpos_to_bytexpos (obj, i); + return textobj_memxpos_to_bytexpos (obj, i); } } ＠＠ -1692,7 +1683,7 ＠＠ { Memxpos i = endp ? extent_end (extent) : extent_start (extent); Lisp_Object obj = extent_object (extent); - return buffer_or_string_memxpos_to_charxpos (obj, i); + return textobj_memxpos_to_charxpos (obj, i); } } ＠＠ -1831,7 +1822,7 ＠＠ extent_object (extent) = object; /* Now make sure the extent info exists. */ if (!NILP (object)) - buffer_or_string_extent_info_force (object); + extent_object_extent_info_force (object); return extent; } ＠＠ -1865,7 +1856,7 ＠＠ static EXTENT extent_first (Lisp_Object obj) { - Extent_List *el = buffer_or_string_extent_list (obj); + Extent_List *el = extent_object_extent_list (obj); if (!el) return 0; ＠＠ -1876,7 +1867,7 ＠＠ static EXTENT extent_e_first (Lisp_Object obj) { - Extent_List *el = buffer_or_string_extent_list (obj); + Extent_List *el = extent_object_extent_list (obj); if (!el) return 0; ＠＠ -1909,7 +1900,7 ＠＠ static EXTENT extent_last (Lisp_Object obj) { - Extent_List *el = buffer_or_string_extent_list (obj); + Extent_List *el = extent_object_extent_list (obj); if (!el) return 0; ＠＠ -1920,7 +1911,7 ＠＠ static EXTENT extent_e_last (Lisp_Object obj) { - Extent_List *el = buffer_or_string_extent_list (obj); + Extent_List *el = extent_object_extent_list (obj); if (!el) return 0; ＠＠ -2027,9 +2018,9 ＠＠ default: ABORT(); return 0; } - start = buffer_or_string_bytexpos_to_startind (obj, from, + start = textobj_bytexpos_to_startind (obj, from, flags & ME_START_OPEN); - end = buffer_or_string_bytexpos_to_endind (obj, to, + end = textobj_bytexpos_to_endind (obj, to, ! (flags & ME_END_CLOSED)); exs = memxpos_to_startind (extent_start (extent), start_open); exe = memxpos_to_endind (extent_end (extent), end_open); ＠＠ -2128,10 +2119,10 ＠＠ #ifdef ERROR_CHECK_EXTENTS assert (from <= to); - assert (from >= buffer_or_string_absolute_begin_byte (obj) && - from <= buffer_or_string_absolute_end_byte (obj) && - to >= buffer_or_string_absolute_begin_byte (obj) && - to <= buffer_or_string_absolute_end_byte (obj)); + assert (from >= textobj_absolute_begin_byte (obj) && + from <= textobj_absolute_end_byte (obj) && + to >= textobj_absolute_begin_byte (obj) && + to <= textobj_absolute_end_byte (obj)); #endif if (after) ＠＠ -2140,15 +2131,15 ＠＠ assert (!extent_detached_p (after)); } - el = buffer_or_string_extent_list (obj); + el = extent_object_extent_list (obj); if (!el || !extent_list_num_els (el)) return; el = 0; PROFILE_RECORD_ENTERING_SECTION (QSin_map_extents_internal); - st = buffer_or_string_bytexpos_to_memxpos (obj, from); - en = buffer_or_string_bytexpos_to_memxpos (obj, to); + st = textobj_bytexpos_to_memxpos (obj, from); + en = textobj_bytexpos_to_memxpos (obj, to); if (flags & ME_MIGHT_MODIFY_TEXT) { ＠＠ -2258,7 +2249,7 ＠＠ range_start_type = 2; range_start_pos = 0; #else - Stack_Of_Extents *soe = buffer_or_string_stack_of_extents_force (obj); + Stack_Of_Extents *soe = extent_object_stack_of_extents_force (obj); int numsoe; /* Move the SOE to the closer end of the range. This dictates ＠＠ -2275,7 +2266,7 ＠＠ SOE. */ EXTENT e = extent_list_at (soe->extents, 0, 0); range_start_pos = - extent_list_locate (buffer_or_string_extent_list (obj), e, 0, + extent_list_locate (extent_object_extent_list (obj), e, 0, &foundp); assert (foundp); range_start_type = 2; ＠＠ -2309,14 +2300,14 ＠＠ { /* The SOE stage */ if (!do_soe_stage) continue; - el = buffer_or_string_stack_of_extents_force (obj)->extents; + el = extent_object_stack_of_extents_force (obj)->extents; /* We will always be looping over start extents here. */ assert (!range_endp); pos = 0; } else { /* The range stage */ - el = buffer_or_string_extent_list (obj); + el = extent_object_extent_list (obj); switch (range_start_type) { case 0: ＠＠ -2337,7 +2328,7 ＠＠ if (posm) /* Delete the marker used in the SOE stage. */ extent_list_delete_marker - (buffer_or_string_stack_of_extents_force (obj)->extents, posm); + (extent_object_stack_of_extents_force (obj)->extents, posm); posm = extent_list_make_marker (el, pos, range_endp); /* tell the unwind function about the marker. */ closure.el = el; ＠＠ -2416,9 +2407,9 ＠＠ obj2 = extent_object (e); if (extent_in_region_p (e, - buffer_or_string_memxpos_to_bytexpos (obj2, + textobj_memxpos_to_bytexpos (obj2, st), - buffer_or_string_memxpos_to_bytexpos (obj2, + textobj_memxpos_to_bytexpos (obj2, en), flags)) { ＠＠ -2481,7 +2472,7 ＠＠ #ifdef ERROR_CHECK_EXTENTS sledgehammer_extent_check (obj); #endif - el = buffer_or_string_extent_list (obj); + el = extent_object_extent_list (obj); if (!el || !extent_list_num_els(el)) return; ＠＠ -2509,7 +2500,7 ＠＠ /* The index for the buffer's SOE is a memory index and thus needs to be adjusted like a marker. */ - soe = buffer_or_string_stack_of_extents (obj); + soe = extent_object_stack_of_extents (obj); if (soe && soe->pos >= 0) soe->pos = do_marker_adjustment (soe->pos, from, to, amount); } ＠＠ -2555,7 +2546,7 ＠＠ Memxpos adjust_to = (Memxpos) (to + gapsize); Bytecount amount = - numdel - movegapsize; Memxpos oldsoe = 0, newsoe = 0; - Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (object); + Stack_Of_Extents *soe = extent_object_stack_of_extents (object); #ifdef ERROR_CHECK_EXTENTS sledgehammer_extent_check (object); ＠＠ -2678,24 +2669,24 ＠＠ extent_find_end_of_run (Lisp_Object obj, Bytexpos pos, int outside_accessible) { Extent_List *sel; - Extent_List *bel = buffer_or_string_extent_list (obj); + Extent_List *bel = extent_object_extent_list (obj); Bytexpos pos1, pos2; int elind1, elind2; - Memxpos mempos = buffer_or_string_bytexpos_to_memxpos (obj, pos); + Memxpos mempos = textobj_bytexpos_to_memxpos (obj, pos); Bytexpos limit = outside_accessible ? - buffer_or_string_absolute_end_byte (obj) : - buffer_or_string_accessible_end_byte (obj); + textobj_absolute_end_byte (obj) : + textobj_accessible_end_byte (obj); if (!bel || !extent_list_num_els (bel)) return limit; - sel = buffer_or_string_stack_of_extents_force (obj)->extents; + sel = extent_object_stack_of_extents_force (obj)->extents; soe_move (obj, mempos); /* Find the first start position after POS. */ elind1 = extent_list_locate_from_pos (bel, mempos+1, 0); if (elind1 < extent_list_num_els (bel)) - pos1 = buffer_or_string_memxpos_to_bytexpos + pos1 = textobj_memxpos_to_bytexpos (obj, extent_start (extent_list_at (bel, elind1, 0))); else pos1 = limit; ＠＠ -2705,7 +2696,7 ＠＠ equal to POS1, so we just have to look in the SOE. */ elind2 = extent_list_locate_from_pos (sel, mempos+1, 1); if (elind2 < extent_list_num_els (sel)) - pos2 = buffer_or_string_memxpos_to_bytexpos + pos2 = textobj_memxpos_to_bytexpos (obj, extent_end (extent_list_at (sel, elind2, 1))); else pos2 = limit; ＠＠ -2718,24 +2709,24 ＠＠ int outside_accessible) { Extent_List *sel; - Extent_List *bel = buffer_or_string_extent_list (obj); + Extent_List *bel = extent_object_extent_list (obj); Bytexpos pos1, pos2; int elind1, elind2; - Memxpos mempos = buffer_or_string_bytexpos_to_memxpos (obj, pos); + Memxpos mempos = textobj_bytexpos_to_memxpos (obj, pos); Bytexpos limit = outside_accessible ? - buffer_or_string_absolute_begin_byte (obj) : - buffer_or_string_accessible_begin_byte (obj); + textobj_absolute_begin_byte (obj) : + textobj_accessible_begin_byte (obj); if (!bel || !extent_list_num_els(bel)) return limit; - sel = buffer_or_string_stack_of_extents_force (obj)->extents; + sel = extent_object_stack_of_extents_force (obj)->extents; soe_move (obj, mempos); /* Find the first end position before POS. */ elind1 = extent_list_locate_from_pos (bel, mempos, 1); if (elind1 > 0) - pos1 = buffer_or_string_memxpos_to_bytexpos + pos1 = textobj_memxpos_to_bytexpos (obj, extent_end (extent_list_at (bel, elind1 - 1, 1))); else pos1 = limit; ＠＠ -2745,7 +2736,7 ＠＠ equal to POS1, so we just have to look in the SOE. */ elind2 = extent_list_locate_from_pos (sel, mempos, 0); if (elind2 > 0) - pos2 = buffer_or_string_memxpos_to_bytexpos + pos2 = textobj_memxpos_to_bytexpos (obj, extent_start (extent_list_at (sel, elind2 - 1, 0))); else pos2 = limit; ＠＠ -2754,11 +2745,11 ＠＠ } struct extent_fragment * -extent_fragment_new (Lisp_Object buffer_or_string, struct frame *frm) +extent_fragment_new (Lisp_Object extent_object, struct frame *frm) { struct extent_fragment *ef = xnew_and_zero (struct extent_fragment); - ef->object = buffer_or_string; + ef->object = extent_object; ef->frm = frm; ef->extents = Dynarr_new (EXTENT); ef->begin_glyphs = Dynarr_new (glyph_block); ＠＠ -2919,14 +2910,14 ＠＠ int i; int seen_glyph = NILP (last_glyph) ? 1 : 0; Extent_List *sel = - buffer_or_string_stack_of_extents_force (ef->object)->extents; + extent_object_stack_of_extents_force (ef->object)->extents; EXTENT lhe = 0; struct extent dummy_lhe_extent; - Memxpos mempos = buffer_or_string_bytexpos_to_memxpos (ef->object, pos); + Memxpos mempos = textobj_bytexpos_to_memxpos (ef->object, pos); #ifdef ERROR_CHECK_EXTENTS - assert (pos >= buffer_or_string_accessible_begin_byte (ef->object) - && pos <= buffer_or_string_accessible_end_byte (ef->object)); + assert (pos >= textobj_accessible_begin_byte (ef->object) + && pos <= textobj_accessible_end_byte (ef->object)); #endif Dynarr_reset (ef->extents); ＠＠ -2958,13 +2949,15 ＠＠ if (extent_start (e) == mempos && !NILP (extent_begin_glyph (e))) { Lisp_Object glyph = extent_begin_glyph (e); - if (seen_glyph) { - struct glyph_block gb; + if (seen_glyph) + { + struct glyph_block gb; - gb.glyph = glyph; - gb.extent = wrap_extent (e); - Dynarr_add (ef->begin_glyphs, gb); - } + gb.glyph = glyph; + gb.extent = wrap_extent (e); + gb.matchspec = gb.extent; + Dynarr_add (ef->begin_glyphs, gb); + } else if (EQ (glyph, last_glyph)) seen_glyph = 1; } ＠＠ -2977,13 +2970,15 ＠＠ if (extent_end (e) == mempos && !NILP (extent_end_glyph (e))) { Lisp_Object glyph = extent_end_glyph (e); - if (seen_glyph) { - struct glyph_block gb; + if (seen_glyph) + { + struct glyph_block gb; - gb.glyph = glyph; - gb.extent = wrap_extent (e); - Dynarr_add (ef->end_glyphs, gb); - } + gb.glyph = glyph; + gb.extent = wrap_extent (e); + gb.matchspec = gb.extent; + Dynarr_add (ef->end_glyphs, gb); + } else if (EQ (glyph, last_glyph)) seen_glyph = 1; } ＠＠ -3483,7 +3478,7 ＠＠ if (EXTENTP (extent)) next = extent_next (decode_extent (extent, DE_MUST_BE_ATTACHED)); else - next = extent_first (decode_buffer_or_string (extent)); + next = extent_first (decode_extent_object (extent)); if (!next) return Qnil; ＠＠ -3503,7 +3498,7 ＠＠ if (EXTENTP (extent)) prev = extent_previous (decode_extent (extent, DE_MUST_BE_ATTACHED)); else - prev = extent_last (decode_buffer_or_string (extent)); + prev = extent_last (decode_extent_object (extent)); if (!prev) return Qnil; ＠＠ -3524,7 +3519,7 ＠＠ if (EXTENTP (extent)) next = extent_e_next (decode_extent (extent, DE_MUST_BE_ATTACHED)); else - next = extent_e_first (decode_buffer_or_string (extent)); + next = extent_e_first (decode_extent_object (extent)); if (!next) return Qnil; ＠＠ -3544,7 +3539,7 ＠＠ if (EXTENTP (extent)) prev = extent_e_previous (decode_extent (extent, DE_MUST_BE_ATTACHED)); else - prev = extent_e_last (decode_buffer_or_string (extent)); + prev = extent_e_last (decode_extent_object (extent)); if (!prev) return Qnil; ＠＠ -3561,12 +3556,12 ＠＠ */ (pos, object)) { - Lisp_Object obj = decode_buffer_or_string (object); + Lisp_Object obj = decode_extent_object (object); Bytexpos xpos; - xpos = get_buffer_or_string_pos_byte (obj, pos, GB_ALLOW_PAST_ACCESSIBLE); + xpos = get_textobj_pos_byte (obj, pos, GB_ALLOW_PAST_ACCESSIBLE); xpos = extent_find_end_of_run (obj, xpos, 1); - return make_int (buffer_or_string_bytexpos_to_charxpos (obj, xpos)); + return make_int (textobj_bytexpos_to_charxpos (obj, xpos)); } DEFUN ("previous-extent-change", Fprevious_extent_change, 1, 2, 0, /* ＠＠ -3577,12 +3572,12 ＠＠ */ (pos, object)) { - Lisp_Object obj = decode_buffer_or_string (object); + Lisp_Object obj = decode_extent_object (object); Bytexpos xpos; - xpos = get_buffer_or_string_pos_byte (obj, pos, GB_ALLOW_PAST_ACCESSIBLE); + xpos = get_textobj_pos_byte (obj, pos, GB_ALLOW_PAST_ACCESSIBLE); xpos = extent_find_beginning_of_run (obj, xpos, 1); - return make_int (buffer_or_string_bytexpos_to_charxpos (obj, xpos)); + return make_int (textobj_bytexpos_to_charxpos (obj, xpos)); }  ＠＠ -3849,9 +3844,9 ＠＠ } start = s < 0 ? extent_start (extent) : - buffer_or_string_bytexpos_to_memxpos (object, s); + textobj_bytexpos_to_memxpos (object, s); end = e < 0 ? extent_end (extent) : - buffer_or_string_bytexpos_to_memxpos (object, e); + textobj_bytexpos_to_memxpos (object, e); set_extent_endpoints_1 (extent, start, end); } ＠＠ -3956,7 +3951,7 ＠＠ Lisp_Object extent_obj; Lisp_Object obj; - obj = decode_buffer_or_string (buffer_or_string); + obj = decode_extent_object (buffer_or_string); if (NILP (from) && NILP (to)) { if (NILP (buffer_or_string)) ＠＠ -3967,7 +3962,7 ＠＠ { Bytexpos start, end; - get_buffer_or_string_range_byte (obj, from, to, &start, &end, + get_textobj_range_byte (obj, from, to, &start, &end, GB_ALLOW_PAST_ACCESSIBLE); extent_obj = wrap_extent (make_extent (obj, start, end)); } ＠＠ -3985,7 +3980,7 ＠＠ if (NILP (buffer_or_string)) buffer_or_string = extent_object (ext); else - buffer_or_string = decode_buffer_or_string (buffer_or_string); + buffer_or_string = decode_extent_object (buffer_or_string); return wrap_extent (copy_extent (ext, -1, -1, buffer_or_string)); } ＠＠ -4058,15 +4053,15 ＠＠ buffer_or_string = Fcurrent_buffer (); } else - buffer_or_string = decode_buffer_or_string (buffer_or_string); + buffer_or_string = decode_extent_object (buffer_or_string); if (NILP (start) && NILP (end)) return Fdetach_extent (extent); - get_buffer_or_string_range_byte (buffer_or_string, start, end, &s, &e, + get_textobj_range_byte (buffer_or_string, start, end, &s, &e, GB_ALLOW_PAST_ACCESSIBLE); - buffer_or_string_extent_info_force (buffer_or_string); + extent_object_extent_info_force (buffer_or_string); set_extent_endpoints (ext, s, e, buffer_or_string); return extent; } ＠＠ -4143,7 +4138,7 ＠＠ EXTENT ext = decode_extent (extent, DE_MUST_BE_ATTACHED); Lisp_Object obj = extent_object (ext); - get_buffer_or_string_range_byte (obj, from, to, &start, &end, GB_ALLOW_NIL | + get_textobj_range_byte (obj, from, to, &start, &end, GB_ALLOW_NIL | GB_ALLOW_PAST_ACCESSIBLE); return extent_in_region_p (ext, start, end, decode_map_extents_flags (flags)) ? ＠＠ -4276,9 +4271,9 ＠＠ object = extent_object (after); } else - object = decode_buffer_or_string (object); + object = decode_extent_object (object); - get_buffer_or_string_range_byte (object, from, to, &start, &end, + get_textobj_range_byte (object, from, to, &start, &end, GB_ALLOW_NIL | GB_ALLOW_PAST_ACCESSIBLE); me_flags = decode_map_extents_flags (flags); ＠＠ -4417,9 +4412,9 ＠＠ object = extent_object (after); } else - object = decode_buffer_or_string (object); + object = decode_extent_object (object); - get_buffer_or_string_range_byte (object, from, to, &start, &end, + get_textobj_range_byte (object, from, to, &start, &end, GB_ALLOW_NIL | GB_ALLOW_PAST_ACCESSIBLE); me_flags = decode_map_extents_flags (flags); ＠＠ -4555,11 +4550,11 ＠＠ Also, the openness stuff in the text-property code currently does not check its limits and might go off the end. */ if ((at_flag == EXTENT_AT_BEFORE - ? position <= buffer_or_string_absolute_begin_byte (object) - : position < buffer_or_string_absolute_begin_byte (object)) + ? position <= textobj_absolute_begin_byte (object) + : position < textobj_absolute_begin_byte (object)) || (at_flag == EXTENT_AT_AFTER - ? position >= buffer_or_string_absolute_end_byte (object) - : position > buffer_or_string_absolute_end_byte (object))) + ? position >= textobj_absolute_end_byte (object) + : position > textobj_absolute_end_byte (object))) return Qnil; closure.best_match = Qnil; ＠＠ -4615,8 +4610,8 ＠＠ EXTENT before_extent; enum extent_at_flag fl; - object = decode_buffer_or_string (object); - position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD); + object = decode_extent_object (object); + position = get_textobj_pos_byte (object, pos, GB_NO_ERROR_IF_BAD); if (NILP (before)) before_extent = 0; else ＠＠ -4665,8 +4660,8 ＠＠ EXTENT before_extent; enum extent_at_flag fl; - object = decode_buffer_or_string (object); - position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD); + object = decode_extent_object (object); + position = get_textobj_pos_byte (object, pos, GB_NO_ERROR_IF_BAD); if (NILP (before)) before_extent = 0; else ＠＠ -4746,8 +4741,8 ＠＠ As far as I know, this doesn't currently occur in XEmacs. --ben */ closed = (from==to); closure.object = object; - closure.start = buffer_or_string_bytexpos_to_memxpos (object, from); - closure.end = buffer_or_string_bytexpos_to_memxpos (object, to); + closure.start = textobj_bytexpos_to_memxpos (object, from); + closure.end = textobj_bytexpos_to_memxpos (object, to); closure.iro = inhibit_read_only_value; map_extents (from, to, verify_extent_mapper, (void *) &closure, ＠＠ -4775,7 +4770,7 ＠＠ { struct process_extents_for_insertion_arg *closure = (struct process_extents_for_insertion_arg *) arg; - Memxpos indice = buffer_or_string_bytexpos_to_memxpos (closure->object, + Memxpos indice = textobj_bytexpos_to_memxpos (closure->object, closure->opoint); /* When this function is called, one end of the newly-inserted text should ＠＠ -4894,8 +4889,8 ＠＠ { struct process_extents_for_deletion_arg closure; - closure.start = buffer_or_string_bytexpos_to_memxpos (object, from); - closure.end = buffer_or_string_bytexpos_to_memxpos (object, to); + closure.start = textobj_bytexpos_to_memxpos (object, from); + closure.end = textobj_bytexpos_to_memxpos (object, to); closure.destroy_included_extents = destroy_them; map_extents (from, to, process_extents_for_deletion_mapper, ＠＠ -5324,8 +5319,9 ＠＠ } DEFUN ("set-extent-begin-glyph", Fset_extent_begin_glyph, 2, 3, 0, /* -Display a bitmap, subwindow or string at the beginning of EXTENT. +Display a glyph (image, widget or string) at the beginning of EXTENT. BEGIN-GLYPH must be a glyph object. The layout policy defaults to `text'. +See `make-glyph'. */ (extent, begin_glyph, layout)) { ＠＠ -5333,8 +5329,9 ＠＠ } DEFUN ("set-extent-end-glyph", Fset_extent_end_glyph, 2, 3, 0, /* -Display a bitmap, subwindow or string at the end of EXTENT. +Display a glyph (image, widget or string) at the beginning of EXTENT. END-GLYPH must be a glyph object. The layout policy defaults to `text'. +See `make-glyph'. */ (extent, end_glyph, layout)) { ＠＠ -6035,8 +6032,8 ＠＠ Lisp_Object object = extent_object (e); /* This function can GC */ return run_extent_copy_paste_internal - (e, buffer_or_string_bytexpos_to_charxpos (object, from), - buffer_or_string_bytexpos_to_charxpos (object, to), object, + (e, textobj_bytexpos_to_charxpos (object, from), + textobj_bytexpos_to_charxpos (object, to), object, Qcopy_function); } ＠＠ -6046,8 +6043,8 ＠＠ { /* This function can GC */ return run_extent_copy_paste_internal - (e, buffer_or_string_bytexpos_to_charxpos (object, from), - buffer_or_string_bytexpos_to_charxpos (object, to), object, + (e, textobj_bytexpos_to_charxpos (object, from), + textobj_bytexpos_to_charxpos (object, to), object, Qpaste_function); } ＠＠ -6127,8 +6124,8 ＠＠ Lisp_Object copy; Bytexpos s, e; - buffer_or_string = decode_buffer_or_string (buffer_or_string); - get_buffer_or_string_range_byte (buffer_or_string, start, end, &s, &e, + buffer_or_string = decode_extent_object (buffer_or_string); + get_textobj_range_byte (buffer_or_string, start, end, &s, &e, GB_ALLOW_PAST_ACCESSIBLE); copy = insert_extent (ext, s, e, buffer_or_string, NILP (no_hooks)); ＠＠ -6544,8 +6541,8 ＠＠ Bytexpos position; int invert = 0; - object = decode_buffer_or_string (object); - position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD); + object = decode_extent_object (object); + position = get_textobj_pos_byte (object, pos, GB_NO_ERROR_IF_BAD); /* We canonicalize the start/end-open/closed properties to the non-default version -- "adding" the default property really ＠＠ -6941,8 +6938,8 ＠＠ /* This function can GC */ Bytexpos s, e; - object = decode_buffer_or_string (object); - get_buffer_or_string_range_byte (object, start, end, &s, &e, 0); + object = decode_extent_object (object); + get_textobj_range_byte (object, start, end, &s, &e, 0); put_text_prop (s, e, object, prop, value, 1); return prop; } ＠＠ -6961,8 +6958,8 ＠＠ /* This function can GC */ Bytexpos s, e; - object = decode_buffer_or_string (object); - get_buffer_or_string_range_byte (object, start, end, &s, &e, 0); + object = decode_extent_object (object); + get_textobj_range_byte (object, start, end, &s, &e, 0); put_text_prop (s, e, object, prop, value, 0); return prop; } ＠＠ -6980,8 +6977,8 ＠＠ int changed = 0; Bytexpos s, e; - object = decode_buffer_or_string (object); - get_buffer_or_string_range_byte (object, start, end, &s, &e, 0); + object = decode_extent_object (object); + get_textobj_range_byte (object, start, end, &s, &e, 0); CHECK_LIST (props); for (; !NILP (props); props = Fcdr (Fcdr (props))) { ＠＠ -7008,8 +7005,8 ＠＠ int changed = 0; Bytexpos s, e; - object = decode_buffer_or_string (object); - get_buffer_or_string_range_byte (object, start, end, &s, &e, 0); + object = decode_extent_object (object); + get_textobj_range_byte (object, start, end, &s, &e, 0); CHECK_LIST (props); for (; !NILP (props); props = Fcdr (Fcdr (props))) { ＠＠ -7033,8 +7030,8 ＠＠ int changed = 0; Bytexpos s, e; - object = decode_buffer_or_string (object); - get_buffer_or_string_range_byte (object, start, end, &s, &e, 0); + object = decode_extent_object (object); + get_textobj_range_byte (object, start, end, &s, &e, 0); CHECK_LIST (props); for (; !NILP (props); props = Fcdr (Fcdr (props))) { ＠＠ -7094,8 +7091,8 ＠＠ enum extent_at_flag at_flag = next ? EXTENT_AT_AFTER : EXTENT_AT_BEFORE; if (limit < 0) { - limit = (next ? buffer_or_string_accessible_end_byte : - buffer_or_string_accessible_begin_byte) (object); + limit = (next ? textobj_accessible_end_byte : + textobj_accessible_begin_byte) (object); limit_was_nil = 1; } else ＠＠ -7143,16 +7140,16 ＠＠ Bytexpos xpos; Bytexpos blim; - object = decode_buffer_or_string (object); - xpos = get_buffer_or_string_pos_byte (object, pos, 0); - blim = !NILP (limit) ? get_buffer_or_string_pos_byte (object, limit, 0) : -1; + object = decode_extent_object (object); + xpos = get_textobj_pos_byte (object, pos, 0); + blim = !NILP (limit) ? get_textobj_pos_byte (object, limit, 0) : -1; blim = next_previous_single_property_change (xpos, prop, object, blim, next, text_props_only); if (blim < 0) return Qnil; else - return make_int (buffer_or_string_bytexpos_to_charxpos (object, blim)); + return make_int (textobj_bytexpos_to_charxpos (object, blim)); } DEFUN ("next-single-property-change", Fnext_single_property_change, ＠＠ -7457,10 +7454,10 ＠＠ to do `eq' comparison because the lists of faces are already memoized. */ Vextent_face_memoize_hash_table = - make_lisp_hash_table (100, HASH_TABLE_VALUE_WEAK, HASH_TABLE_EQUAL); + make_lisp_hash_table (100, hash_table_value_weak, HASH_TABLE_EQUAL); staticpro (&Vextent_face_reverse_memoize_hash_table); Vextent_face_reverse_memoize_hash_table = - make_lisp_hash_table (100, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (100, hash_table_key_weak, HASH_TABLE_EQ); QSin_map_extents_internal = build_msg_string ("(in map-extents-internal)"); staticpro (&QSin_map_extents_internal); 1.44.4.1 +7 -10 XEmacs/xemacs/src/faces.c Index: faces.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/faces.c,v retrieving revision 1.44 retrieving revision 1.44.4.1 diff -u -r1.44 -r1.44.4.1 --- faces.c 2005/01/24 23:33:54 1.44 +++ faces.c 2005/02/16 00:43:10 1.44.4.1 ＠＠ -57,8 +57,9 ＠＠ Lisp_Object Vleft_margin_face, Vright_margin_face, Vtext_cursor_face; Lisp_Object Vpointer_face, Vvertical_divider_face, Vtoolbar_face, Vwidget_face; -/* Qdefault, Qhighlight, Qleft_margin, Qright_margin defined in general.c */ -Lisp_Object Qmodeline, Qgui_element, Qtext_cursor, Qvertical_divider; +/* Qdefault, Qmodeline, Qhighlight, Qwidget, Qleft_margin, Qright_margin + defined in general.c */ +Lisp_Object Qgui_element, Qtext_cursor, Qvertical_divider; /* In the old implementation Vface_list was a list of the face names, not the faces themselves. We now distinguish between permanent and ＠＠ -1833,8 +1834,8 ＠＠ { INIT_LRECORD_IMPLEMENTATION (face); - /* Qdefault, Qwidget, Qleft_margin, Qright_margin defined in general.c */ - DEFSYMBOL (Qmodeline); + /* Qdefault, Qmodeline, Qhighlight, Qwidget, Qleft_margin, Qright_margin + defined in general.c */ DEFSYMBOL (Qgui_element); DEFSYMBOL (Qtext_cursor); DEFSYMBOL (Qvertical_divider); ＠＠ -1881,10 +1882,10 ＠＠ { staticpro (&Vpermanent_faces_cache); Vpermanent_faces_cache = - make_lisp_hash_table (10, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (10, hash_table_non_weak, HASH_TABLE_EQ); staticpro (&Vtemporary_faces_cache); Vtemporary_faces_cache = - make_lisp_hash_table (0, HASH_TABLE_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (0, hash_table_weak, HASH_TABLE_EQ); staticpro (&Vdefault_face); Vdefault_face = Qnil; ＠＠ -1927,11 +1928,7 ＠＠ Vbuilt_in_face_specifiers = Flist (n, syms); staticpro (&Vbuilt_in_face_specifiers); } -} -void -complex_vars_of_faces (void) -{ /* Create the default face now so we know what it is immediately. */ Vdefault_face = Qnil; /* so that Fmake_face() doesn't set up a bogus 1.44.4.1 +2 -2 XEmacs/xemacs/src/file-coding.c Index: file-coding.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/file-coding.c,v retrieving revision 1.44 retrieving revision 1.44.4.1 diff -u -r1.44 -r1.44.4.1 --- file-coding.c 2005/02/03 16:14:06 1.44 +++ file-coding.c 2005/02/16 00:43:10 1.44.4.1 ＠＠ -4462,7 +4462,7 ＠＠ staticpro (&Vcoding_system_hash_table); Vcoding_system_hash_table = - make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (50, hash_table_non_weak, HASH_TABLE_EQ); the_coding_system_type_entry_dynarr = Dynarr_new (coding_system_type_entry); dump_add_root_block_ptr (&the_coding_system_type_entry_dynarr, ＠＠ -4643,7 +4643,7 ＠＠ enable_multibyte_characters = 1; Vchain_canonicalize_hash_table = - make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); + make_lisp_hash_table (50, hash_table_non_weak, HASH_TABLE_EQUAL); staticpro (&Vchain_canonicalize_hash_table); #ifdef DEBUG_XEMACS 1.104.4.1 +8 -8 XEmacs/xemacs/src/fileio.c Index: fileio.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/fileio.c,v retrieving revision 1.104 retrieving revision 1.104.4.1 diff -u -r1.104 -r1.104.4.1 --- fileio.c 2005/01/28 02:36:24 1.104 +++ fileio.c 2005/02/16 00:43:12 1.104.4.1 ＠＠ -1472,7 +1472,7 ＠＠ { Lisp_Object resolved_name; int rlen = qxestrlen (resolved_path); - if (elen > 0 && IS_DIRECTORY_SEP (string_byte (expanded_name, elen - 1)) + if (elen > 0 && IS_DIRECTORY_SEP (string_byte_at (expanded_name, elen - 1)) && !(rlen > 0 && IS_DIRECTORY_SEP (resolved_path[rlen - 1]))) { if (rlen + 1 > countof (resolved_path)) ＠＠ -1706,8 +1706,8 ＠＠ /* Remove final slash, if any (unless path is root). stat behaves differently depending! */ if (XSTRING_LENGTH (abspath) > 1 - && IS_DIRECTORY_SEP (string_byte (abspath, XSTRING_LENGTH (abspath) - 1)) - && !IS_DEVICE_SEP (string_byte (abspath, XSTRING_LENGTH (abspath) - 2))) + && IS_DIRECTORY_SEP (string_byte_at (abspath, XSTRING_LENGTH (abspath) - 1)) + && !IS_DEVICE_SEP (string_byte_at (abspath, XSTRING_LENGTH (abspath) - 2))) /* We cannot take shortcuts; they might be wrong for magic file names. */ abspath = Fdirectory_file_name (abspath); UNGCPRO; ＠＠ -1822,7 +1822,7 ＠＠ args[1] = Qnil; args[2] = Qnil; NGCPRO1 (*args); ngcpro1.nvars = 3; - if (!IS_DIRECTORY_SEP (string_byte (newname, + if (!IS_DIRECTORY_SEP (string_byte_at (newname, XSTRING_LENGTH (newname) - 1))) args[i++] = Fchar_to_string (Vdirectory_sep_char); ＠＠ -2064,7 +2064,7 ＠＠ args[1] = Qnil; args[2] = Qnil; NGCPRO1 (*args); ngcpro1.nvars = 3; - if (string_byte (newname, XSTRING_LENGTH (newname) - 1) != '/') + if (string_byte_at (newname, XSTRING_LENGTH (newname) - 1) != '/') args[i++] = build_string ("/"); args[i++] = Ffile_name_nondirectory (filename); newname = Fconcat (i, args); ＠＠ -2174,7 +2174,7 ＠＠ /* If the link target has a ~, we must expand it to get a truly valid file name. Otherwise, do not expand; we want to permit links to relative file names. */ - if (string_byte (filename, 0) == '~') + if (string_byte_at (filename, 0) == '~') filename = Fexpand_file_name (filename, Qnil); linkname = Fexpand_file_name (linkname, Qnil); ＠＠ -2976,7 +2976,7 ＠＠ break; charbpos = 0; while (charbpos < nread && same_at_start < BUF_ZV (buf) - && BUF_FETCH_CHAR (buf, same_at_start) == + && BUF_ICHAR_AT (buf, same_at_start) == buffer[charbpos]) same_at_start++, charbpos++; /* If we found a discrepancy, stop the scan. ＠＠ -3027,7 +3027,7 ＠＠ /* Compare with same_at_start to avoid counting some buffer text as matching both at the file's beginning and at the end. */ while (charbpos > 0 && same_at_end > same_at_start - && BUF_FETCH_CHAR (buf, same_at_end - 1) == + && BUF_ICHAR_AT (buf, same_at_end - 1) == buffer[charbpos - 1]) same_at_end--, charbpos--; /* If we found a discrepancy, stop the scan. 1.62.4.1 +22 -4 XEmacs/xemacs/src/fns.c Index: fns.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/fns.c,v retrieving revision 1.62 retrieving revision 1.62.4.1 diff -u -r1.62 -r1.62.4.1 --- fns.c 2005/01/24 23:33:55 1.62 +++ fns.c 2005/02/16 00:43:13 1.62.4.1 ＠＠ -504,6 +504,7 ＠＠ The last argument is not copied, just used as the tail of the new list. Also see: `nconc'. */ + /* (&rest args) */ (int nargs, Lisp_Object *args)) { return concat (nargs, args, c_cons, 1); ＠＠ -519,6 +520,7 ＠＠ returning "foo50" will fail. To fix such code, either apply `int-to-string' to the integer argument, or use `format'. */ + /* (&rest args) */ (int nargs, Lisp_Object *args)) { return concat (nargs, args, c_string, 0); ＠＠ -529,6 +531,7 ＠＠ The result is a vector whose elements are the elements of all the arguments. Each argument may be a list, vector, bit vector, or string. */ + /* (&rest args) */ (int nargs, Lisp_Object *args)) { return concat (nargs, args, c_vector, 0); ＠＠ -539,6 +542,7 ＠＠ The result is a bit vector whose elements are the elements of all the arguments. Each argument may be a list, vector, bit vector, or string. */ + /* (&rest args) */ (int nargs, Lisp_Object *args)) { return concat (nargs, args, c_bit_vector, 0); ＠＠ -1961,6 +1965,17 ＠＠ /* property-list functions */ /************************************************************************/ +Lisp_Object +make_plist_from_lisp_object_pair_array (int numels, Lisp_Object_pair *els) +{ + int i; + + Lisp_Object result = Qnil; + for (i = 0; i < numels; i++) + result = cons3 (els[i].value, els[i].key, result); + return Fnreverse (result); +} + /* For properties of text, we need to do order-insensitive comparison of plists. That is, we need to compare two plists such that they are the same if they have the same set of keys, and equivalent values. ＠＠ -2704,7 +2719,7 ＠＠ This is the last VALUE stored with `(put OBJECT PROPERTY VALUE)'. If there is no such property, return optional third arg DEFAULT \(which defaults to `nil'). OBJECT can be a symbol, string, extent, -face, or glyph. See also `put', `remprop', and `object-plist'. +event, face, or glyph. See also `put', `remprop', and `object-plist'. */ (object, property, default_)) { ＠＠ -2723,7 +2738,7 ＠＠ DEFUN ("put", Fput, 3, 3, 0, /* Set OBJECT's PROPERTY to VALUE. It can be subsequently retrieved with `(get OBJECT PROPERTY)'. -OBJECT can be a symbol, face, extent, or string. +OBJECT can be a symbol, string, extent, face, or glyph. For a string, no properties currently have predefined meanings. For the predefined properties for extents, see `set-extent-property'. For the predefined properties for faces, see `set-face-property'. ＠＠ -2773,7 +2788,7 ＠＠ DEFUN ("object-plist", Fobject_plist, 1, 1, 0, /* Return a property list of OBJECT's properties. For a symbol, this is equivalent to `symbol-plist'. -OBJECT can be a symbol, string, extent, face, or glyph. +OBJECT can be a symbol, string, extent, event, face, or glyph. Do not modify the returned property list directly; this may or may not have the desired effects. Use `put' instead. */ ＠＠ -3065,6 +3080,7 ＠＠ effect; therefore, write `(setq foo (nconc foo list))' to be sure of changing the value of `foo'. */ + /* (&rest args) */ (int nargs, Lisp_Object *args)) { int argnum = 0; ＠＠ -3346,7 +3362,9 ＠＠ Destructively replace the list OLD with NEW. This is like (copy-sequence NEW) except that it reuses the conses in OLD as much as possible. If OLD and NEW are the same -length, no consing will take place. +length, no consing will take place. The new list shares no +conses with OLD. Returns the replaced list (which should be +assigned to OLD, since OLD might have been empty beforehand). */ (old, new)) { 1.16.4.1 +3 -3 XEmacs/xemacs/src/font-lock.c Index: font-lock.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/font-lock.c,v retrieving revision 1.16 retrieving revision 1.16.4.1 diff -u -r1.16 -r1.16.4.1 --- font-lock.c 2005/01/24 23:33:55 1.16 +++ font-lock.c 2005/02/16 00:43:15 1.16.4.1 ＠＠ -342,7 +342,7 ＠＠ /* #### shouldn't this be checking the character's syntax instead of explicitly testing for backslash characters? */ context_cache.backslash_p = ((pt > 1) && - (BUF_FETCH_CHAR (buf, pt - 1) == '\\')); + (BUF_ICHAR_AT (buf, pt - 1) == '\\')); /* Note that the BOL context cache may not be at the beginning of the line, but that should be OK, nobody's checking. */ bol_context_cache = context_cache; ＠＠ -450,7 +450,7 ＠＠ 1); if (pt > BUF_BEGV (buf)) { - c = BUF_FETCH_CHAR (buf, pt - 1); + c = BUF_ICHAR_AT (buf, pt - 1); syncode = SYNTAX_CODE_FROM_CACHE (scache, c); } else ＠＠ -495,7 +495,7 ＠＠ UPDATE_SYNTAX_CACHE_FORWARD (scache, pt); prev_c = c; prev_syncode = syncode; - c = BUF_FETCH_CHAR (buf, pt); + c = BUF_ICHAR_AT (buf, pt); syncode = SYNTAX_CODE_FROM_CACHE (scache, c); if (prev_c == '\n') 1.20.4.1 +8 -8 XEmacs/xemacs/src/frame-gtk.c Index: frame-gtk.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/frame-gtk.c,v retrieving revision 1.20 retrieving revision 1.20.4.1 diff -u -r1.20 -r1.20.4.1 --- frame-gtk.c 2005/01/24 23:33:56 1.20 +++ frame-gtk.c 2005/02/16 00:43:15 1.20.4.1 ＠＠ -664,16 +664,16 ＠＠ delete_event_cb (GtkWidget *UNUSED (w), GdkEvent *UNUSED (ev), gpointer user_data) { - struct frame *f = (struct frame *) user_data; - Lisp_Object frame = wrap_frame (f); + struct frame *f = (struct frame *) user_data; + Lisp_Object frame = wrap_frame (f); - enqueue_misc_user_event (frame, Qeval, list3 (Qdelete_frame, frame, Qt)); + enqueue_notify_event (NOTIFY_CLOSE_FRAME, frame); + + /* See if tickling the event queue helps us with our delays when + clicking 'close' */ + signal_fake_event (); - /* See if tickling the event queue helps us with our delays when - clicking 'close' */ - signal_fake_event (); - - return (TRUE); + return (TRUE); } extern gboolean emacs_shell_event_handler (GtkWidget *wid, GdkEvent *event, gpointer closure); 1.4.6.1 +15 -15 XEmacs/xemacs/src/frame-impl.h Index: frame-impl.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/frame-impl.h,v retrieving revision 1.4 retrieving revision 1.4.6.1 diff -u -r1.4 -r1.4.6.1 --- frame-impl.h 2003/01/12 11:08:16 1.4 +++ frame-impl.h 2005/02/16 00:43:16 1.4.6.1 ＠＠ -84,8 +84,8 ＠＠ int modiff; - struct expose_ignore *subwindow_exposures; - struct expose_ignore *subwindow_exposures_tail; + struct expose_ignore *subcontrol_exposures; + struct expose_ignore *subcontrol_exposures_tail; #ifdef HAVE_SCROLLBARS /* frame-local scrollbar information. See scrollbar.c. */ ＠＠ -178,8 +178,8 ＠＠ unsigned int frame_changed :1; unsigned int frame_layout_changed :1; /* The layout of frame elements has changed. */ - unsigned int subwindows_changed :1; - unsigned int subwindows_state_changed :1; + unsigned int subcontrols_changed :1; + unsigned int subcontrols_state_changed :1; unsigned int glyphs_changed :1; unsigned int icon_changed :1; unsigned int menubar_changed :1; ＠＠ -197,8 +197,8 ＠＠ unsigned int size_change_pending :1; unsigned int mirror_dirty :1; - /* flag indicating if any window on this frame is displaying a subwindow */ - unsigned int subwindows_being_displayed :1; + /* flag indicating if any window on this frame is displaying a subcontrol */ + unsigned int subcontrols_being_displayed :1; }; /* Redefine basic properties more efficiently */ ＠＠ -325,30 +325,30 ＠＠ glyphs_changed = 1; \ } while (0) -#define MARK_FRAME_SUBWINDOWS_CHANGED(f) do { \ +#define MARK_FRAME_SUBCONTROLS_CHANGED(f) do { \ struct frame *mfgc_f = (f); \ - mfgc_f->subwindows_changed = 1; \ + mfgc_f->subcontrols_changed = 1; \ mfgc_f->modiff++; \ if (!NILP (mfgc_f->device)) \ { \ struct device *mfgc_d = XDEVICE (mfgc_f->device); \ - MARK_DEVICE_SUBWINDOWS_CHANGED (mfgc_d); \ + MARK_DEVICE_SUBCONTROLS_CHANGED (mfgc_d); \ } \ else \ - subwindows_changed = 1; \ + subcontrols_changed = 1; \ } while (0) -#define MARK_FRAME_SUBWINDOWS_STATE_CHANGED(f) do { \ +#define MARK_FRAME_SUBCONTROLS_STATE_CHANGED(f) do { \ struct frame *mfgc_f = (f); \ - mfgc_f->subwindows_state_changed = 1; \ + mfgc_f->subcontrols_state_changed = 1; \ mfgc_f->modiff++; \ if (!NILP (mfgc_f->device)) \ { \ struct device *mfgc_d = XDEVICE (mfgc_f->device); \ - MARK_DEVICE_SUBWINDOWS_STATE_CHANGED (mfgc_d); \ + MARK_DEVICE_SUBCONTROLS_STATE_CHANGED (mfgc_d); \ } \ else \ - subwindows_state_changed = 1; \ + subcontrols_state_changed = 1; \ } while (0) #define MARK_FRAME_TOOLBARS_CHANGED(f) do { \ ＠＠ -505,7 +505,7 ＠＠ 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_instance_cache) +#define FRAME_SUBCONTROL_CACHE(f) ((f)->subcontrol_instance_cache) #if 0 /* FSFmacs */ 1.55.6.1 +4 -5 XEmacs/xemacs/src/frame-msw.c Index: frame-msw.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/frame-msw.c,v retrieving revision 1.55 retrieving revision 1.55.6.1 diff -u -r1.55 -r1.55.6.1 --- frame-msw.c 2004/11/04 23:06:30 1.55 +++ frame-msw.c 2005/02/16 00:43:16 1.55.6.1 ＠＠ -168,18 +168,18 ＠＠ #ifdef HAVE_TOOLBARS /* EQ not EQUAL or we will get QUIT crashes, see below. */ FRAME_MSWINDOWS_TOOLBAR_HASH_TABLE (f) = - make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (50, hash_table_non_weak, HASH_TABLE_EQ); #endif /* hashtable of instantiated glyphs on the frame. Make them EQ because we only use ints as keys. Otherwise we run into stickiness in redisplay because internal_equal() can QUIT. See enter_redisplay_critical_section(). */ FRAME_MSWINDOWS_WIDGET_HASH_TABLE1 (f) = - make_lisp_hash_table (50, HASH_TABLE_VALUE_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (50, hash_table_value_weak, HASH_TABLE_EQ); FRAME_MSWINDOWS_WIDGET_HASH_TABLE2 (f) = - make_lisp_hash_table (50, HASH_TABLE_VALUE_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (50, hash_table_value_weak, HASH_TABLE_EQ); FRAME_MSWINDOWS_WIDGET_HASH_TABLE3 (f) = - make_lisp_hash_table (50, HASH_TABLE_VALUE_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (50, hash_table_value_weak, HASH_TABLE_EQ); /* 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; ＠＠ -309,7 +309,6 ＠＠ #endif mark_object (FRAME_MSWINDOWS_WIDGET_HASH_TABLE1 (f)); mark_object (FRAME_MSWINDOWS_WIDGET_HASH_TABLE2 (f)); - mark_object (FRAME_MSWINDOWS_WIDGET_HASH_TABLE3 (f)); } static void 1.69.4.1 +6 -7 XEmacs/xemacs/src/frame-x.c Index: frame-x.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/frame-x.c,v retrieving revision 1.69 retrieving revision 1.69.4.1 diff -u -r1.69 -r1.69.4.1 --- frame-x.c 2005/01/24 23:33:56 1.69 +++ frame-x.c 2005/02/16 00:43:16 1.69.4.1 ＠＠ -1235,7 +1235,7 ＠＠ /* this needs to be changed to the new protocol: - we need the button, modifier and pointer states to create a - correct misc_user_event + correct event - the data must be converted to the new format (URL/MIME) */ /* return; */ ＠＠ -1304,12 +1304,11 ＠＠ /* The Problem: no button and mods from CDE... */ if (enqueue) - enqueue_misc_user_event_pos (frame, Qdragdrop_drop_dispatch, - Fcons (l_type, l_data), - 0 /* this is the button */, - 0 /* these are the mods */, - transferInfo->x, - transferInfo->y); + enqueue_drop_event (frame, l_type, l_data, + 0 /* this is the button */, + 0 /* these are the mods */, + transferInfo->x, + transferInfo->y); UNGCPRO; return; 1.68.4.1 +84 -62 XEmacs/xemacs/src/frame.c Index: frame.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/frame.c,v retrieving revision 1.68 retrieving revision 1.68.4.1 diff -u -r1.68 -r1.68.4.1 --- frame.c 2005/02/03 16:30:36 1.68 +++ frame.c 2005/02/16 00:43:17 1.68.4.1 ＠＠ -52,7 +52,6 ＠＠ Lisp_Object Vunmap_frame_hook, Qunmap_frame_hook; int allow_deletion_of_last_visible_frame; Lisp_Object Vadjust_frame_function; -Lisp_Object Vmouse_motion_handler; Lisp_Object Vsynchronize_minibuffers; Lisp_Object Qsynchronize_minibuffers; Lisp_Object Qbuffer_predicate; ＠＠ -118,6 +117,7 ＠＠ Lisp_Object Qframe_being_created; static void store_minibuf_frame_prop (struct frame *f, Lisp_Object val); +static int internal_frame_property_p (struct frame *f, Lisp_Object prop); typedef enum { DISPLAYABLE_PIXEL_TO_CHAR, ＠＠ -188,9 +188,9 ＠＠ { XD_LISP_OBJECT_ARRAY, offsetof (struct frame, slot), size }, #include "frameslots.h" - { XD_BLOCK_PTR, offsetof (struct frame, subwindow_exposures), + { XD_BLOCK_PTR, offsetof (struct frame, subcontrol_exposures), 1, { &expose_ignore_description } }, - { XD_BLOCK_PTR, offsetof (struct frame, subwindow_exposures_tail), + { XD_BLOCK_PTR, offsetof (struct frame, subcontrol_exposures_tail), 1, { &expose_ignore_description } }, #ifdef HAVE_SCROLLBARS ＠＠ -249,11 +249,20 ＠＠ write_fmt_string (printcharfun, " 0x%x>", frm->header.uid); } -DEFINE_LRECORD_IMPLEMENTATION ("frame", frame, - 0, /*dumpable-flag*/ - mark_frame, print_frame, 0, 0, 0, - frame_description, - struct frame); +static Lisp_Object frame_getprop (Lisp_Object obj, Lisp_Object prop); +static int frame_putprop (Lisp_Object obj, Lisp_Object prop, + Lisp_Object value); +static int frame_remprop (Lisp_Object obj, Lisp_Object prop); +static Lisp_Object frame_plist (Lisp_Object obj); + +DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("frame", frame, + 0, /*dumpable-flag*/ + mark_frame, print_frame, + 0, 0, 0, + frame_description, + frame_getprop, frame_putprop, + frame_remprop, frame_plist, + struct frame);  static void nuke_all_frame_slots (struct frame *f) ＠＠ -301,12 +310,12 ＠＠ f->selected_window = root_window; f->last_nonminibuf_window = root_window; - /* cache of subwindows visible on frame */ - f->subwindow_instance_cache = make_weak_list (WEAK_LIST_SIMPLE); + /* cache of subcontrols visible on frame */ + f->subcontrol_instance_cache = make_image_instance_frame_cache (); /* associated exposure ignore list */ - f->subwindow_exposures = 0; - f->subwindow_exposures_tail = 0; + f->subcontrol_exposures = 0; + f->subcontrol_exposures_tail = 0; FRAME_SET_PAGENUMBER (f, 1); ＠＠ -320,7 +329,7 ＠＠ buf = Fcurrent_buffer (); /* If buf is a 'hidden' buffer (i.e. one whose name starts with a space), try to find another one. */ - if (string_ichar (Fbuffer_name (buf), 0) == ' ') + if (string_ichar_at (Fbuffer_name (buf), 0) == ' ') buf = Fother_buffer (buf, Qnil, Qnil); Fset_window_buffer (root_window, buf, Qnil); } ＠＠ -1634,12 +1643,13 ＠＠ free_frame_toolbars (f); #endif free_frame_gutters (f); - /* Unfortunately deleting the frame will also delete the parent of - all of the subwindow instances current on the frame. I think this - can lead to bad things when trying to finalize the - instances. Thus we loop over all instance caches calling the - finalize method for each instance. */ - free_frame_subwindow_instances (f); + /* Unfortunately deleting the frame will also delete the parent of all of + the subcontrol instances current on the frame. I think this can lead + to bad things when trying to finalize the instances. Thus unmap, + finalize, and clear out all the instances in the cache. (Deleting a + window also does the same thing; in this case, calling + delete_all_child_windows() below will have no effect.) */ + free_frame_subcontrols (f); /* This must be done before the window and window_mirror structures are freed. The scrollbar information is attached to them. */ ＠＠ -1647,11 +1657,11 ＠＠ /* Mark all the windows that used to be on FRAME as deleted, and then remove the reference to them. */ - delete_all_subwindows (XWINDOW (f->root_window)); + delete_all_child_windows (XWINDOW (f->root_window)); f->root_window = Qnil; /* clear out the cached glyph information */ - f->subwindow_instance_cache = Qnil; + f->subcontrol_instance_cache = Qnil; /* Remove the frame now from the list. This way, any events generated on this frame by the maneuvers below will disperse themselves. */ ＠＠ -2358,6 +2368,26 ＠＠ return prop; } +static int +internal_frame_property_p (struct frame *f, Lisp_Object prop) +{ + prop = get_property_alias (prop); + + if (EQ (prop, Qminibuffer) + || EQ (prop, Qunsplittable) + || EQ (prop, Qbuffer_predicate) + || EQ (prop, Qheight) + || EQ (prop, Qwidth) + || (SYMBOLP (prop) && EQ (Fbuilt_in_variable_type (prop), + Qconst_specifier)) + || (SYMBOLP (prop) && !NILP (Fget (prop, Qconst_glyph_variable, + Qnil))) + || (VECTORP (prop) && XVECTOR_LENGTH (prop) == 2) + || FRAMEMETH_OR_GIVEN (f, internal_frame_property_p, (f, prop), 0)) + return 1; + return 0; +} + /* #### Using this to modify the internal border width has no effect because the change isn't propagated to the windows. Are there other properties which this claims to handle, but doesn't? ＠＠ -2503,19 +2533,7 ＠＠ next_tailp = &XCDR (next); prop = Fcar (*tailp); - prop = get_property_alias (prop); - - if (EQ (prop, Qminibuffer) - || EQ (prop, Qunsplittable) - || EQ (prop, Qbuffer_predicate) - || EQ (prop, Qheight) - || EQ (prop, Qwidth) - || (SYMBOLP (prop) && EQ (Fbuilt_in_variable_type (prop), - Qconst_specifier)) - || (SYMBOLP (prop) && !NILP (Fget (prop, Qconst_glyph_variable, - Qnil))) - || (VECTORP (prop) && XVECTOR_LENGTH (prop) == 2) - || FRAMEMETH_OR_GIVEN (f, internal_frame_property_p, (f, prop), 0)) + if (internal_frame_property_p (f, prop)) *tailp = *next_tailp; tailp = next_tailp; } ＠＠ -2526,12 +2544,8 ＠＠ return Qnil; } -DEFUN ("frame-property", Fframe_property, 2, 3, 0, /* -Return FRAME's value for property PROPERTY. -Return DEFAULT if there is no such property. -See `set-frame-properties' for the built-in property names. -*/ - (frame, property, default_)) +static Lisp_Object +frame_getprop (Lisp_Object frame, Lisp_Object property) { struct frame *f = decode_frame (frame); Lisp_Object value; ＠＠ -2574,13 +2588,13 ＠＠ { if (EQ (Fbuilt_in_variable_type (property), Qconst_specifier)) return Fspecifier_instance (Fsymbol_value (property), - frame, default_, Qnil); + frame, Qunbound, Qnil); if (!NILP (Fget (property, Qconst_glyph_variable, Qnil))) { Lisp_Object glyph = Fsymbol_value (property); CHECK_GLYPH (glyph); return Fspecifier_instance (XGLYPH_IMAGE (glyph), - frame, default_, Qnil); + frame, Qunbound, Qnil); } } ＠＠ -2597,18 +2611,34 ＠＠ if (!UNBOUNDP (value = FRAMEMETH (f, frame_property, (f, property)))) return value; - if (!UNBOUNDP (value = external_plist_get (&f->plist, property, 1, ERROR_ME))) + if (!UNBOUNDP (value = external_plist_get (&f->plist, property, 1, + ERROR_ME))) return value; - return default_; + return Qunbound; } -DEFUN ("frame-properties", Fframe_properties, 0, 1, 0, /* -Return a property list of the properties of FRAME. -Do not modify this list; use `set-frame-property' instead. -*/ - (frame)) +static int +frame_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value) +{ + Fset_frame_properties (obj, list2 (prop, value)); + return 1; +} + +static int +frame_remprop (Lisp_Object obj, Lisp_Object prop) { + struct frame *f = XFRAME (obj); + + if (internal_frame_property_p (f, prop)) + return -1; /* can't remove, #### is this correct? */ + + return external_remprop (&f->plist, prop, 0, ERROR_ME); +} + +static Lisp_Object +frame_plist (Lisp_Object frame) +{ struct frame *f = decode_frame (frame); Lisp_Object result = Qnil; struct gcpro gcpro1; ＠＠ -3068,8 +3098,8 ＠＠ window = FRAME_SELECTED_WINDOW (f); - egw = max (glyph_width (Vcontinuation_glyph, window), - glyph_width (Vtruncation_glyph, window)); + egw = max (glyph_width (Vcontinuation_glyph, window, Qunbound), + glyph_width (Vtruncation_glyph, window, Qunbound)); egw = max (egw, cpw); bdr = 2 * f->internal_border_width; obw = FRAME_SCROLLBAR_WIDTH (f) + FRAME_THEORETICAL_LEFT_TOOLBAR_WIDTH (f) + ＠＠ -3269,9 +3299,9 ＠＠ int adjustment, trunc_width, cont_width; trunc_width = glyph_width (Vtruncation_glyph, - FRAME_SELECTED_WINDOW (f)); + FRAME_SELECTED_WINDOW (f), Qunbound); cont_width = glyph_width (Vcontinuation_glyph, - FRAME_SELECTED_WINDOW (f)); + FRAME_SELECTED_WINDOW (f), Qunbound); adjustment = max (trunc_width, cont_width); adjustment = max (adjustment, font_width); ＠＠ -3515,7 +3545,7 ＠＠ Lisp_Object new_icon; frame = wrap_frame (f); - new_icon = glyph_image_instance (Vframe_icon_glyph, frame, + new_icon = glyph_image_instance (Vframe_icon_glyph, frame, Qunbound, ERROR_ME_WARN, 0); if (!EQ (new_icon, f->icon)) { ＠＠ -3657,8 +3687,6 ＠＠ DEFSUBR (Flower_frame); DEFSUBR (Fdisable_frame); DEFSUBR (Fenable_frame); - DEFSUBR (Fframe_property); - DEFSUBR (Fframe_properties); DEFSUBR (Fset_frame_properties); DEFSUBR (Fframe_pixel_height); DEFSUBR (Fframe_displayable_pixel_height); ＠＠ -3777,12 +3805,6 ＠＠ the frame. */ ); Vadjust_frame_function = Qnil; - - DEFVAR_LISP ("mouse-motion-handler", &Vmouse_motion_handler /* -Handler for motion events. One arg, the event. -For most applications, you should use `mode-motion-hook' instead of this. -*/ ); - Vmouse_motion_handler = Qnil; DEFVAR_LISP ("synchronize-minibuffers",&Vsynchronize_minibuffers /* Set to t if all minibuffer windows are to be synchronized. 1.29.6.1 +0 -1 XEmacs/xemacs/src/frame.h Index: frame.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/frame.h,v retrieving revision 1.29 retrieving revision 1.29.6.1 diff -u -r1.29 -r1.29.6.1 --- frame.h 2003/02/21 06:56:57 1.29 +++ frame.h 2005/02/16 00:43:18 1.29.6.1 ＠＠ -33,7 +33,6 ＠＠ EXFUN (Fdelete_frame, 2); EXFUN (Fframe_iconified_p, 1); EXFUN (Fframe_name, 1); -EXFUN (Fframe_property, 3); EXFUN (Fmake_frame, 2); EXFUN (Fmake_frame_visible, 1); EXFUN (Fraise_frame, 1); 1.9.6.1 +3 -2 XEmacs/xemacs/src/frameslots.h Index: frameslots.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/frameslots.h,v retrieving revision 1.9 retrieving revision 1.9.6.1 diff -u -r1.9 -r1.9.6.1 --- frameslots.h 2003/03/09 02:27:43 1.9 +++ frameslots.h 2005/02/16 00:43:18 1.9.6.1 ＠＠ -157,8 +157,9 ＠＠ MARKED_SLOT_ARRAY (toolbar_border_width, 4) #endif -/* Cache of subwindow instances for this frame */ - MARKED_SLOT (subwindow_instance_cache) +/* Cache of subcontrol instances for this frame. See comment at top of + glyphs.c. */ + MARKED_SLOT (subcontrol_instance_cache) /* Possible frame-local default for outside margin widths. */ MARKED_SLOT (left_margin_width) 1.15.6.1 +25 -6 XEmacs/xemacs/src/general-slots.h Index: general-slots.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/general-slots.h,v retrieving revision 1.15 retrieving revision 1.15.6.1 diff -u -r1.15 -r1.15.6.1 --- general-slots.h 2004/04/05 22:49:54 1.15 +++ general-slots.h 2005/02/16 00:43:19 1.15.6.1 ＠＠ -1,6 +1,6 ＠＠ /* Commonly-used symbols -- include file Copyright (C) 1995 Sun Microsystems. - Copyright (C) 1995, 1996, 2000, 2001, 2002, 2003 Ben Wing. + Copyright (C) 1995, 1996, 2000, 2001, 2002, 2003, 2005 Ben Wing. This file is part of XEmacs. ＠＠ -21,9 +21,19 ＠＠ /* Synched up with: Not in FSF. */ -/* The purpose of this file is as a central place to stick symbols - that don't have any obvious connection to any particular module - and might be used in many different contexts. +/* The purpose of this file is as a central place to stick symbols whose + names are sufficiently simple that they might be used in many different + contexts and modules. + + The main reason for this is that many compilers will issue an error + if a global variable is multiply defined, and trying to keep track of + the resulting dependencies between modules was getting to be a real + headache. + + As a general rule, this means that symbols whose names are simple + English words (perhaps with a colon in front), should be here, and + any others shouldn't. #### In reality, there are a few symbols here + that shouldn't be. Four types of declarations are allowed here: ＠＠ -45,6 +55,7 ＠＠ SYMBOL (Qabort); SYMBOL_KEYWORD (Q_accelerator); +SYMBOL (Qactivate); SYMBOL_KEYWORD (Q_active); SYMBOL (Qactually_requested); SYMBOL (Qafter); ＠＠ -69,8 +80,8 ＠＠ SYMBOL (Qbuilt_in); SYMBOL (Qbutton); SYMBOL_KEYWORD (Q_buttons); +SYMBOL_KEYWORD (Qcallback); SYMBOL_KEYWORD (Q_callback); -SYMBOL_KEYWORD (Q_callback_ex); SYMBOL (Qcancel); SYMBOL (Qcategory); SYMBOL (Qcenter); ＠＠ -111,6 +122,7 ＠＠ SYMBOL (Qdisplay); SYMBOL (Qdoc_string); SYMBOL (Qdocumentation); +SYMBOL (Qdrop); SYMBOL (Qduplex); SYMBOL (Qdynarr_overhead); SYMBOL (Qemergency); ＠＠ -130,6 +142,7 ＠＠ SYMBOL_KEYWORD (Q_filter); SYMBOL (Qfixnum); SYMBOL (Qfloat); +SYMBOL_KEYWORD (Q_focus); SYMBOL (Qfont); SYMBOL (Qframe); SYMBOL (Qframes); ＠＠ -160,7 +173,6 ＠＠ SYMBOL_KEYWORD (Q_included); SYMBOL (Qinfo); SYMBOL (Qinherit); -SYMBOL_KEYWORD (Q_initial_focus); SYMBOL (Qinteger); SYMBOL (Qinternal); SYMBOL_KEYWORD (Q_items); ＠＠ -193,6 +205,7 ＠＠ SYMBOL (Qmenubar); SYMBOL (Qmessage); SYMBOL_GENERAL (Qminus, "-"); +SYMBOL (Qmodeline); SYMBOL (Qmodifiers); SYMBOL (Qmotion); SYMBOL (Qmsprinter); ＠＠ -205,6 +218,7 ＠＠ SYMBOL (Qnot); SYMBOL (Qnothing); SYMBOL_MODULE_API (Qnotice); +SYMBOL (Qnotify); SYMBOL (Qobject); SYMBOL (Qok); SYMBOL (Qold_assoc); ＠＠ -219,6 +233,7 ＠＠ SYMBOL (Qother); SYMBOL (Qpage_setup); SYMBOL (Qpages); +SYMBOL (Q_parent); SYMBOL (Qpeer); SYMBOL (Qpointer); SYMBOL (Qpopup); ＠＠ -245,6 +260,7 ＠＠ SYMBOL (Qreverse); SYMBOL (Qright); SYMBOL (Qright_margin); +SYMBOL (Qscrollbar); SYMBOL_MODULE_API (Qsearch); SYMBOL (Qselected); SYMBOL_KEYWORD (Q_selected); ＠＠ -265,6 +281,7 ＠＠ SYMBOL (Qsymbol); SYMBOL (Qsyntax); SYMBOL (Qsystem_default); +SYMBOL (Q_tag); SYMBOL (Qterminal); SYMBOL (Qtest); SYMBOL (Qtext); ＠＠ -283,6 +300,7 ＠＠ SYMBOL (Qundecided); SYMBOL (Qundefined); SYMBOL (Qunimplemented); +SYMBOL (Qunknown); SYMBOL (Quser_default); SYMBOL_KEYWORD (Q_value); SYMBOL (Qvalue_assoc); ＠＠ -296,5 +314,6 ＠＠ SYMBOL (Qwindow_id); SYMBOL (Qwindow_system); SYMBOL (Qx); +SYMBOL (Qxlike); SYMBOL (Qy); SYMBOL (Qyes); 1.30.4.1 +28 -29 XEmacs/xemacs/src/glyphs-gtk.c Index: glyphs-gtk.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/glyphs-gtk.c,v retrieving revision 1.30 retrieving revision 1.30.4.1 diff -u -r1.30 -r1.30.4.1 --- glyphs-gtk.c 2005/01/26 10:22:26 1.30 +++ glyphs-gtk.c 2005/02/16 00:43:19 1.30.4.1 ＠＠ -386,9 +386,10 ＠＠ #ifdef HAVE_WIDGETS if (IMAGE_INSTANCE_TYPE (p) == IMAGE_WIDGET) { - if (IMAGE_INSTANCE_SUBWINDOW_ID (p)) + if (IMAGE_INSTANCE_SUBCONTROL_ID (p)) { - gtk_widget_destroy ((GtkWidget*) IMAGE_INSTANCE_SUBWINDOW_ID (p)); + gtk_widget_destroy ((GtkWidget *) + IMAGE_INSTANCE_SUBCONTROL_ID (p)); /* We can release the callbacks again. */ /* #### FIXME! */ ＠＠ -549,11 +550,11 ＠＠ /* Check non-absolute pathnames with a directory component relative to the search path; that's the way Xt does it. */ /* #### Unix-specific */ - if (string_byte (name, 0) == '/' || - (string_byte (name, 0) == '.' && - (string_byte (name, 1) == '/' || - (string_byte (name, 1) == '.' && - (string_byte (name, 2) == '/'))))) + if (string_byte_at (name, 0) == '/' || + (string_byte_at (name, 0) == '.' && + (string_byte_at (name, 1) == '/' || + (string_byte_at (name, 1) == '.' && + (string_byte_at (name, 2) == '/'))))) { if (!NILP (Ffile_readable_p (name))) return name; ＠＠ -838,7 +839,7 ＠＠ unsigned long *pixtbl = NULL; int npixels = 0; int slice; - GdkImage* gdk_image; + GdkImage *gdk_image; for (slice = 0; slice < slices; slice++) ＠＠ -1081,7 +1082,7 ＠＠ extract_xpm_color_names (Lisp_Object device, Lisp_Object domain, Lisp_Object color_symbol_alist, - int* nsymbols) + int *nsymbols) { /* This function can GC */ Lisp_Object rest; ＠＠ -1918,13 +1919,13 ＠＠  /************************************************************************/ -/* subwindow and widget support */ +/* subwindow and widget support */ /************************************************************************/ /* unmap the image if it is a widget. This is used by redisplay via - redisplay_unmap_subwindows */ + redisplay_unmap_subcontrols */ static void -gtk_unmap_subwindow (Lisp_Image_Instance *p) +gtk_unmap_subcontrol (Lisp_Image_Instance *p) { if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW) { ＠＠ -1941,11 +1942,11 ＠＠ } } -/* map the subwindow. This is used by redisplay via - redisplay_output_subwindow */ +/* map the subcontrol. This is used by redisplay via + redisplay_output_subcontrol */ static void -gtk_map_subwindow (Lisp_Image_Instance *p, int x, int y, - struct display_glyph_area* dga) +gtk_map_subcontrol (Lisp_Image_Instance *p, int x, int y, + struct display_glyph_area *dga) { assert (dga->width > 0 && dga->height > 0); ＠＠ -2021,7 +2022,7 ＠＠ } } - if (!IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (p)) + if (!IMAGE_INSTANCE_SUBCONTROL_DISPLAYEDP (p)) { gtk_widget_map (wid); } ＠＠ -2030,8 +2031,6 ＠＠ } } -/* when you click on a widget you may activate another widget this - needs to be checked and all appropriate widgets updated */ static void gtk_redisplay_subwindow (Lisp_Image_Instance *p) { ＠＠ -2093,7 +2092,7 ＠＠ /* Possibly update the text. */ if (IMAGE_INSTANCE_TEXT_CHANGED (p)) { - char* str; + char *str; Lisp_Object val = IMAGE_INSTANCE_WIDGET_TEXT (p); LISP_STRING_TO_EXTERNAL (val, str, Qnative); ＠＠ -2149,13 +2148,13 ＠＠ IMAGE_INSTANCE_TYPE (ii) = IMAGE_SUBWINDOW; - ii->data = xnew_and_zero (struct gtk_subwindow_data); + ii->data = xnew_and_zero (struct gtk_subcontrol_data); /* Create a window for clipping */ IMAGE_INSTANCE_GTK_CLIPWINDOW (ii) = NULL; /* Now put the subwindow inside the clip window. */ - IMAGE_INSTANCE_SUBWINDOW_ID (ii) = (void *) NULL; + IMAGE_INSTANCE_SUBCONTROL_ID (ii) = (void *) NULL; } #ifdef HAVE_WIDGETS ＠＠ -2205,7 +2204,7 ＠＠ { if (wv->contents) { - widget_value* val = wv->contents, *cur; + widget_value *val = wv->contents, *cur; /* Give each child label the correct foreground color. */ Lisp_Object pixel = FACE_FOREGROUND ＠＠ -2246,7 +2245,7 ＠＠ LISP_STRING_TO_EXTERNAL (IMAGE_INSTANCE_WIDGET_TEXT (ii), nm, Qnative); } - ii->data = xnew_and_zero (struct gtk_subwindow_data); + ii->data = xnew_and_zero (struct gtk_subcontrol_data); /* Create a clipping widget */ IMAGE_INSTANCE_GTK_CLIPWIDGET (ii) = NULL; ＠＠ -2272,7 +2271,7 ＠＠ UNGCPRO; - IMAGE_INSTANCE_SUBWINDOW_ID (ii) = (void *) w; + IMAGE_INSTANCE_SUBCONTROL_ID (ii) = (void *) w; /* #### HACK!!!! We should make this do the right thing if we ** really need a clip widget! ＠＠ -2404,7 +2403,7 ＠＠ /* check the state of a button */ if (EQ (prop, Q_selected)) { - if (GTK_WIDGET_HAS_FOCUS (IMAGE_INSTANCE_SUBWINDOW_ID (ii))) + if (GTK_WIDGET_HAS_FOCUS (IMAGE_INSTANCE_SUBCONTROL_ID (ii))) return Qt; else return Qnil; ＠＠ -2429,7 +2428,7 ＠＠ val = XGUI_ITEM (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii))->value; f = XFLOATINT (val); - gtk_progress_set_value (GTK_PROGRESS (IMAGE_INSTANCE_SUBWINDOW_ID (ii)), + gtk_progress_set_value (GTK_PROGRESS (IMAGE_INSTANCE_SUBCONTROL_ID (ii)), f); } } ＠＠ -2748,8 +2747,8 ＠＠ CONSOLE_HAS_METHOD (gtk, colorize_image_instance); CONSOLE_HAS_METHOD (gtk, init_image_instance_from_eimage); CONSOLE_HAS_METHOD (gtk, locate_pixmap_file); - CONSOLE_HAS_METHOD (gtk, unmap_subwindow); - CONSOLE_HAS_METHOD (gtk, map_subwindow); + CONSOLE_HAS_METHOD (gtk, unmap_subcontrol); + CONSOLE_HAS_METHOD (gtk, map_subcontrol); CONSOLE_HAS_METHOD (gtk, redisplay_widget); CONSOLE_HAS_METHOD (gtk, redisplay_subwindow); } 1.3.6.1 +18 -18 XEmacs/xemacs/src/glyphs-gtk.h Index: glyphs-gtk.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/glyphs-gtk.h,v retrieving revision 1.3 retrieving revision 1.3.6.1 diff -u -r1.3 -r1.3.6.1 --- glyphs-gtk.h 2004/05/15 07:43:09 1.3 +++ glyphs-gtk.h 2005/02/16 00:43:20 1.3.6.1 ＠＠ -53,7 +53,7 ＠＠ the textual color table and the comments? Is that useful? */ }; -struct gtk_subwindow_data +struct gtk_subcontrol_data { union { ＠＠ -107,32 +107,32 ＠＠ #define XIMAGE_INSTANCE_GTK_NPIXELS(i) \ IMAGE_INSTANCE_GTK_NPIXELS (XIMAGE_INSTANCE (i)) -/* Subwindow / widget stuff */ -#define GTK_SUBWINDOW_INSTANCE_DATA(i) ((struct gtk_subwindow_data *) (i)->data) +/* Subcontrol stuff */ +#define GTK_SUBCONTROL_INSTANCE_DATA(i) ((struct gtk_subcontrol_data *) (i)->data) -#define IMAGE_INSTANCE_GTK_SUBWINDOW_PARENT(i) \ - (GTK_SUBWINDOW_INSTANCE_DATA (i)->data.sub.parent_window) +#define IMAGE_INSTANCE_GTK_SUBCONTROL_PARENT(i) \ + (GTK_SUBCONTROL_INSTANCE_DATA (i)->data.sub.parent_window) #define IMAGE_INSTANCE_GTK_CLIPWINDOW(i) \ - (GTK_SUBWINDOW_INSTANCE_DATA (i)->data.sub.clip_window) + (GTK_SUBCONTROL_INSTANCE_DATA (i)->data.sub.clip_window) #define IMAGE_INSTANCE_GTK_WIDGET_XOFFSET(i) \ - (GTK_SUBWINDOW_INSTANCE_DATA (i)->data.wid.x_offset) + (GTK_SUBCONTROL_INSTANCE_DATA (i)->data.wid.x_offset) #define IMAGE_INSTANCE_GTK_WIDGET_YOFFSET(i) \ - (GTK_SUBWINDOW_INSTANCE_DATA (i)->data.wid.y_offset) + (GTK_SUBCONTROL_INSTANCE_DATA (i)->data.wid.y_offset) #define IMAGE_INSTANCE_GTK_WIDGET_LWID(i) \ - (GTK_SUBWINDOW_INSTANCE_DATA (i)->data.wid.id) + (GTK_SUBCONTROL_INSTANCE_DATA (i)->data.wid.id) #define IMAGE_INSTANCE_GTK_CLIPWIDGET(i) \ - (GTK_SUBWINDOW_INSTANCE_DATA (i)->data.wid.clip_window) + (GTK_SUBCONTROL_INSTANCE_DATA (i)->data.wid.clip_window) #define IMAGE_INSTANCE_GTK_ALREADY_PUT(i) \ - (GTK_SUBWINDOW_INSTANCE_DATA (i)->data.wid.added_to_fixed) + (GTK_SUBCONTROL_INSTANCE_DATA (i)->data.wid.added_to_fixed) #define IMAGE_INSTANCE_GTK_SUBWINDOW_ID(i) \ - ((GdkWindow *) & IMAGE_INSTANCE_SUBWINDOW_ID (i)) + ((GdkWindow *) & IMAGE_INSTANCE_SUBCONTROL_ID (i)) #define IMAGE_INSTANCE_GTK_WIDGET_ID(i) \ - ((GtkWidget *) & IMAGE_INSTANCE_SUBWINDOW_ID (i)) + ((GtkWidget *) & IMAGE_INSTANCE_SUBCONTROL_ID (i)) -#define XIMAGE_INSTANCE_GTK_SUBWINDOW_PARENT(i) \ - IMAGE_INSTANCE_GTK_SUBWINDOW_PARENT (XIMAGE_INSTANCE (i)) -#define XIMAGE_INSTANCE_GTK_SUBWINDOW_DISPLAY(i) \ - IMAGE_INSTANCE_GTK_SUBWINDOW_DISPLAY (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_GTK_SUBCONTROL_PARENT(i) \ + IMAGE_INSTANCE_GTK_SUBCONTROL_PARENT (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_GTK_SUBCONTROL_DISPLAY(i) \ + IMAGE_INSTANCE_GTK_SUBCONTROL_DISPLAY (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_GTK_WIDGET_XOFFSET(i) \ IMAGE_INSTANCE_GTK_WIDGET_XOFFSET (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_GTK_WIDGET_YOFFSET(i) \ ＠＠ -148,7 +148,7 ＠＠ #define DOMAIN_GTK_WIDGET(domain) \ ((IMAGE_INSTANCEP (domain) && \ - GTK_SUBWINDOW_INSTANCE_DATA (XIMAGE_INSTANCE (domain))) ? \ + GTK_SUBCONTROL_INSTANCE_DATA (XIMAGE_INSTANCE (domain))) ? \ XIMAGE_INSTANCE_GTK_WIDGET_ID (domain) : \ FRAME_GTK_CONTAINER_WIDGET (f) (DOMAIN_XFRAME (domain))) 1.55.4.1 +41 -35 XEmacs/xemacs/src/glyphs-msw.c Index: glyphs-msw.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/glyphs-msw.c,v retrieving revision 1.55 retrieving revision 1.55.4.1 diff -u -r1.55 -r1.55.4.1 --- glyphs-msw.c 2005/01/24 23:33:57 1.55 +++ glyphs-msw.c 2005/02/16 00:43:21 1.55.4.1 ＠＠ -304,11 +304,11 ＠＠ /* Check non-absolute pathnames with a directory component relative to the search path; that's the way Xt does it. */ - if (IS_DIRECTORY_SEP(string_byte (name, 0)) || - (string_byte (name, 0) == '.' && - (IS_DIRECTORY_SEP(string_byte (name, 1)) || - (string_byte (name, 1) == '.' && - (IS_DIRECTORY_SEP(string_byte (name, 2))))))) + if (IS_DIRECTORY_SEP(string_byte_at (name, 0)) || + (string_byte_at (name, 0) == '.' && + (IS_DIRECTORY_SEP(string_byte_at (name, 1)) || + (string_byte_at (name, 1) == '.' && + (IS_DIRECTORY_SEP(string_byte_at (name, 2))))))) { if (!NILP (Ffile_readable_p (name))) return Fexpand_file_name (name, Qnil); ＠＠ -1755,7 +1755,7 ＠＠ debug_widget_instances--; stderr_out ("widget destroyed, %d left\n", debug_widget_instances); #endif - if (IMAGE_INSTANCE_SUBWINDOW_ID (p)) + if (IMAGE_INSTANCE_SUBCONTROL_ID (p)) { /* DestroyWindow is not safe here, as it will send messages to our window proc. */ ＠＠ -1765,7 +1765,7 ＠＠ register_post_gc_action (finalize_destroy_window, (void *) (IMAGE_INSTANCE_MSWINDOWS_CLIPWINDOW (p))); - IMAGE_INSTANCE_SUBWINDOW_ID (p) = 0; + IMAGE_INSTANCE_SUBCONTROL_ID (p) = 0; } } else if (p->data) ＠＠ -1871,11 +1871,11 ＠＠ #endif /* unmap the image if it is a widget. This is used by redisplay via - redisplay_unmap_subwindows */ + redisplay_unmap_subcontrols */ static void -mswindows_unmap_subwindow (Lisp_Image_Instance *p) +mswindows_unmap_subcontrol (Lisp_Image_Instance *p) { - if (IMAGE_INSTANCE_SUBWINDOW_ID (p)) + if (IMAGE_INSTANCE_SUBCONTROL_ID (p)) { #ifdef DEFER_WINDOW_POS struct frame *f = XFRAME (IMAGE_INSTANCE_FRAME (p)); ＠＠ -1910,10 +1910,10 ＠＠ } } -/* map the subwindow. This is used by redisplay via - redisplay_output_subwindow */ +/* map the subcontrol. This is used by redisplay via + redisplay_output_subcontrol */ static void -mswindows_map_subwindow (Lisp_Image_Instance *p, int x, int y, +mswindows_map_subcontrol (Lisp_Image_Instance *p, int x, int y, struct display_glyph_area *dga) { #ifdef DEFER_WINDOW_POS ＠＠ -1934,7 +1934,7 ＠＠ SWP_NOZORDER | SWP_NOSIZE | SWP_NOCOPYBITS | SWP_NOSENDCHANGING); /* ... now map it - we are not allowed to move it at the same time. */ - if (!IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (p)) + if (!IMAGE_INSTANCE_SUBCONTROL_DISPLAYEDP (p)) { #ifdef DEFER_WINDOW_POS new_hdwp = DeferWindowPos ＠＠ -1963,6 +1963,7 ＠＠ SWP_NOZORDER | SWP_NOSIZE | SWP_NOMOVE | SWP_SHOWWINDOW | SWP_NOCOPYBITS | SWP_NOACTIVATE); +#if 0 /* #### */ /* Doing this once does not seem to be enough, for instance when mapping the search dialog this gets called four times. If we only set on the first time through then the subwindow never ＠＠ -1972,13 +1973,14 ＠＠ focus doesn't seem so bad. */ if (IMAGE_INSTANCE_WANTS_INITIAL_FOCUS (p)) SetFocus (WIDGET_INSTANCE_MSWINDOWS_HANDLE (p)); +#endif /* 0 */ #endif } } -/* resize the subwindow instance */ +/* resize the subcontrol instance */ static void -mswindows_resize_subwindow (Lisp_Image_Instance *ii, int w, int h) +mswindows_resize_control (Lisp_Image_Instance *ii, int w, int h) { /* Set the size of the control .... */ if (!SetWindowPos (WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii), ＠＠ -1993,7 +1995,7 ＠＠ static void mswindows_redisplay_subwindow (Lisp_Image_Instance *p) { - mswindows_resize_subwindow (p, + mswindows_resize_control (p, IMAGE_INSTANCE_WIDTH (p), IMAGE_INSTANCE_HEIGHT (p)); } ＠＠ -2021,7 +2023,7 ＠＠ /* Possibly update the dimensions. */ if (IMAGE_INSTANCE_SIZE_CHANGED (p)) { - mswindows_resize_subwindow (p, + mswindows_resize_control (p, IMAGE_INSTANCE_WIDTH (p), IMAGE_INSTANCE_HEIGHT (p)); } ＠＠ -2034,6 +2036,12 ＠＠ qxeSendMessage (WIDGET_INSTANCE_MSWINDOWS_HANDLE (p), WM_SETTEXT, 0, (LPARAM) lparam); } + /* Set the focus if desired. */ + if (IMAGE_INSTANCE_WIDGET_WANTS_FOCUS (p)) + { + SetFocus (WIDGET_INSTANCE_MSWINDOWS_HANDLE (p)); + IMAGE_INSTANCE_WIDGET_WANTS_FOCUS (p) = 0; + } /* Set active state. */ if (IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (p)) { ＠＠ -2077,10 +2085,8 ＠＠ WIDGET_GLYPH_SLOT); Fputhash (make_int (id), image_instance, FRAME_MSWINDOWS_WIDGET_HASH_TABLE1 (f)); - Fputhash (make_int (id), XGUI_ITEM (gui)->callback, + Fputhash (make_int (id), gui, FRAME_MSWINDOWS_WIDGET_HASH_TABLE2 (f)); - Fputhash (make_int (id), XGUI_ITEM (gui)->callback_ex, - FRAME_MSWINDOWS_WIDGET_HASH_TABLE3 (f)); return id; } ＠＠ -2110,7 +2116,7 ＠＠ instantiation for a widget */ IMAGE_INSTANCE_TYPE (ii) = IMAGE_SUBWINDOW; /* Allocate space for the clip window */ - ii->data = xnew_and_zero (struct mswindows_subwindow_data); + ii->data = xnew_and_zero (struct mswindows_subcontrol_data); if ((IMAGE_INSTANCE_MSWINDOWS_CLIPWINDOW (ii) = qxeCreateWindowEx ( ＠＠ -2144,8 +2150,8 ＠＠ GWL_HINSTANCE), NULL); - qxeSetWindowLong (wnd, GWL_USERDATA, (LONG)LISP_TO_VOID(image_instance)); - IMAGE_INSTANCE_SUBWINDOW_ID (ii) = wnd; + qxeSetWindowLong (wnd, GWL_USERDATA, (LONG) LISP_TO_VOID (image_instance)); + IMAGE_INSTANCE_SUBCONTROL_ID (ii) = wnd; } #endif /* HAVE_WIDGETS */ ＠＠ -2242,7 +2248,7 ＠＠ style = pgui->style; - if (!NILP (pgui->callback) || !NILP (pgui->callback_ex)) + if (!NILP (pgui->callback)) { id = mswindows_register_widget_instance (image_instance, domain); } ＠＠ -2251,7 +2257,7 ＠＠ LISP_STRING_TO_TSTR (IMAGE_INSTANCE_WIDGET_TEXT (ii), nm); /* allocate space for the clip window and then allocate the clip window */ - ii->data = xnew_and_zero (struct mswindows_subwindow_data); + ii->data = xnew_and_zero (struct mswindows_subcontrol_data); if ((IMAGE_INSTANCE_MSWINDOWS_CLIPWINDOW (ii) = qxeCreateWindowEx (WS_EX_CONTROLPARENT, /* EX flags */ ＠＠ -2282,7 +2288,7 ＠＠ IMAGE_INSTANCE_WIDGET_HEIGHT (ii), /* parent window */ IMAGE_INSTANCE_MSWINDOWS_CLIPWINDOW (ii), - (HMENU)id, /* No menu */ + (HMENU) id, /* No menu */ (HINSTANCE) qxeGetWindowLong (FRAME_MSWINDOWS_HANDLE (XFRAME (frame)), ＠＠ -2291,8 +2297,8 ＠＠ gui_error ("window creation failed with code", make_int (GetLastError())); - IMAGE_INSTANCE_SUBWINDOW_ID (ii) = wnd; - qxeSetWindowLong (wnd, GWL_USERDATA, (LONG)LISP_TO_VOID(image_instance)); + IMAGE_INSTANCE_SUBCONTROL_ID (ii) = wnd; + qxeSetWindowLong (wnd, GWL_USERDATA, (LONG) LISP_TO_VOID (image_instance)); /* set the widget font from the widget face */ if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii))) qxeSendMessage (wnd, WM_SETFONT, ＠＠ -2352,7 +2358,8 ＠＠ if (!NILP (glyph)) { if (!IMAGE_INSTANCEP (glyph)) - glyph = glyph_image_instance (glyph, domain, ERROR_ME, 1); + glyph = glyph_image_instance (glyph, domain, image_instance, + ERROR_ME, 1); if (IMAGE_INSTANCEP (glyph)) flags |= XIMAGE_INSTANCE_MSWINDOWS_BITMAP (glyph) ? ＠＠ -2665,7 +2672,7 ＠＠ Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); #ifdef DEBUG_WIDGET_OUTPUT stderr_out ("tab control %p redisplayed\n", - IMAGE_INSTANCE_SUBWINDOW_ID (ii)); + IMAGE_INSTANCE_SUBCONTROL_ID (ii)); #endif if (IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii) || ＠＠ -2708,7 +2715,7 ＠＠ qxeSendMessage (wnd, TCM_SETCURSEL, i, 0); #ifdef DEBUG_WIDGET_OUTPUT stderr_out ("tab control %p selected item %d\n", - IMAGE_INSTANCE_SUBWINDOW_ID (ii), i); + IMAGE_INSTANCE_SUBCONTROL_ID (ii), i); #endif break; } ＠＠ -2953,10 +2960,9 ＠＠ /* image methods - display */ 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, unmap_subcontrol); + CONSOLE_HAS_METHOD (mswindows, map_subcontrol); CONSOLE_HAS_METHOD (mswindows, redisplay_subwindow); - CONSOLE_HAS_METHOD (mswindows, resize_subwindow); CONSOLE_HAS_METHOD (mswindows, redisplay_widget); CONSOLE_HAS_METHOD (mswindows, image_instance_equal); CONSOLE_HAS_METHOD (mswindows, image_instance_hash); 1.10.12.1 +8 -8 XEmacs/xemacs/src/glyphs-msw.h Index: glyphs-msw.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/glyphs-msw.h,v retrieving revision 1.10 retrieving revision 1.10.12.1 diff -u -r1.10 -r1.10.12.1 --- glyphs-msw.h 2002/05/05 11:31:38 1.10 +++ glyphs-msw.h 2005/02/16 00:43:21 1.10.12.1 ＠＠ -81,29 +81,29 ＠＠ int cursor); #define WIDGET_INSTANCE_MSWINDOWS_HANDLE(i) \ - (HWND) (IMAGE_INSTANCE_SUBWINDOW_ID (i)) + (HWND) (IMAGE_INSTANCE_SUBCONTROL_ID (i)) #define XWIDGET_INSTANCE_MSWINDOWS_HANDLE(i) \ WIDGET_INSTANCE_MSWINDOWS_HANDLE (XIMAGE_INSTANCE (i)) -struct mswindows_subwindow_data +struct mswindows_subcontrol_data { HWND clip_window; }; -#define MSWINDOWS_SUBWINDOW_DATA(i) \ - ((struct mswindows_subwindow_data *) (i)->data) +#define MSWINDOWS_SUBCONTROL_DATA(i) \ + ((struct mswindows_subcontrol_data *) (i)->data) #define IMAGE_INSTANCE_MSWINDOWS_CLIPWINDOW(i) \ - (MSWINDOWS_SUBWINDOW_DATA (i)->clip_window) + (MSWINDOWS_SUBCONTROL_DATA (i)->clip_window) -#define XIMAGE_INSTANCE_MSWINDOWS_SUBWINDOW_DATA(i) \ - MSWINDOWS_SUBWINDOW_DATA (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_MSWINDOWS_SUBCONTROL_DATA(i) \ + MSWINDOWS_SUBCONTROL_DATA (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_MSWINDOWS_CLIPWINDOW(i) \ IMAGE_INSTANCE_MSWINDOWS_CLIPWINDOW (XIMAGE_INSTANCE (i)) #define DOMAIN_MSWINDOWS_HANDLE(domain) \ ((IMAGE_INSTANCEP (domain) && \ - XIMAGE_INSTANCE_MSWINDOWS_SUBWINDOW_DATA (domain)) ? \ + XIMAGE_INSTANCE_MSWINDOWS_SUBCONTROL_DATA (domain)) ? \ XWIDGET_INSTANCE_MSWINDOWS_HANDLE (domain) : \ FRAME_MSWINDOWS_HANDLE (DOMAIN_XFRAME (domain))) 1.17.6.1 +181 -227 XEmacs/xemacs/src/glyphs-widget.c Index: glyphs-widget.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/glyphs-widget.c,v retrieving revision 1.17 retrieving revision 1.17.6.1 diff -u -r1.17 -r1.17.6.1 --- glyphs-widget.c 2004/11/04 23:06:33 1.17 +++ glyphs-widget.c 2005/02/16 00:43:22 1.17.6.1 ＠＠ -1,6 +1,6 ＠＠ /* Widget-specific glyph objects. Copyright (C) 1998, 1999, 2000, 2002 Andy Piper. - Copyright (C) 2003 Ben Wing. + Copyright (C) 2002, 2003 Ben Wing. This file is part of XEmacs. ＠＠ -45,7 +45,6 ＠＠ DEFINE_IMAGE_INSTANTIATOR_FORMAT (edit_field); Lisp_Object Qedit_field; DEFINE_IMAGE_INSTANTIATOR_FORMAT (scrollbar); -Lisp_Object Qscrollbar; DEFINE_IMAGE_INSTANTIATOR_FORMAT (widget); DEFINE_IMAGE_INSTANTIATOR_FORMAT (label); Lisp_Object Qlabel; ＠＠ -313,8 +312,8 ＠＠ static Lisp_Object widget_property (Lisp_Object image_instance, Lisp_Object prop) { - Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance); - struct image_instantiator_methods* meths; + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + struct image_instantiator_methods *meths; #if 0 /* The usefulness of this is dubious. */ /* first see if its a general property ... */ if (!NILP (Fplist_member (IMAGE_INSTANCE_WIDGET_PROPS (ii), prop))) ＠＠ -331,6 +330,13 ＠＠ ERROR_ME_NOT); if (meths && HAS_IIFORMAT_METH_P (meths, property)) return IIFORMAT_METH (meths, property, (image_instance, prop)); + + /* ^^#### document me better; also, here we need to have some general + mechanism for returning properties. maybe we need to go through all + the properties listed in the VALID_*_KEYWORDS, check if it's a valid + keyword for the widget type, and if so return the corresponding field. + */ + /* ... then fail */ return Qunbound; } ＠＠ -351,10 +357,11 ＠＠ also to make this easy. We would also need a pending_instantiator so that changes could be delayed. */ static void -widget_update (Lisp_Object image_instance, Lisp_Object instantiator) +widget_update (Lisp_Object image_instance, Lisp_Object instantiator, + Lisp_Object domain) { - Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance); - struct image_instantiator_methods* meths; + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + struct image_instantiator_methods *meths; struct gcpro gcpro1; Lisp_Object text = find_keyword_in_vector (instantiator, Q_text); ＠＠ -410,13 +417,14 ＠＠ check_valid_item_list (items); #ifdef DEBUG_WIDGET_OUTPUT stderr_out ("items for widget %p updated\n", - IMAGE_INSTANCE_SUBWINDOW_ID (ii)); + IMAGE_INSTANCE_SUBCONTROL_ID (ii)); #endif /* Don't set the actual items since we might decide not to use the new ones (because nothing has really changed). If we did set them and didn't use them then we would get into whole heaps of trouble when the old items get GC'd. */ - descriptor_item = Fcons (descriptor_item, parse_gui_item_tree_children (items)); + descriptor_item = Fcons (descriptor_item, + parse_gui_item_tree_children (items)); } /* If the descriptor was updated but not the items we need to fill in the `new' items. */ ＠＠ -442,11 +450,11 ＠＠ meths = decode_device_ii_format (image_instance_device (image_instance), IMAGE_INSTANCE_WIDGET_TYPE (ii), ERROR_ME_NOT); - MAYBE_IIFORMAT_METH (meths, update, (image_instance, instantiator)); + MAYBE_IIFORMAT_METH (meths, update, (image_instance, instantiator, domain)); /* ... then format specific methods ... */ meths = decode_device_ii_format (Qnil, IMAGE_INSTANCE_WIDGET_TYPE (ii), ERROR_ME_NOT); - MAYBE_IIFORMAT_METH (meths, update, (image_instance, instantiator)); + MAYBE_IIFORMAT_METH (meths, update, (image_instance, instantiator, domain)); #if 0 /* The usefulness of this is dubious. */ /* we didn't do any device specific properties, so shove the property in our plist. */ IMAGE_INSTANCE_WIDGET_PROPS (ii) ＠＠ -465,8 +473,8 ＠＠ void redisplay_widget (Lisp_Object widget) { - Lisp_Image_Instance* ii = XIMAGE_INSTANCE (widget); - struct image_instantiator_methods* meths; + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (widget); + struct image_instantiator_methods *meths; if (!WIDGET_IMAGE_INSTANCEP (widget) || EQ (IMAGE_INSTANCE_WIDGET_TYPE (ii), Qlayout) ＠＠ -508,7 +516,6 ＠＠ (string, face, width, height, domain)); else query_string_geometry (string, face, width, height, 0, domain); - } /* Determine the spacing of the widget. */ ＠＠ -526,11 +533,11 ＠＠ provided then use the widget text to calculate sizes. */ static void widget_query_geometry (Lisp_Object image_instance, - int* width, int* height, + int *width, int *height, enum image_instance_geometry disp, Lisp_Object domain) { - Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance); - struct image_instantiator_methods* meths; + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + struct image_instantiator_methods *meths; Lisp_Object dynamic_width = Qnil; Lisp_Object dynamic_height = Qnil; ＠＠ -538,9 +545,9 ＠＠ if (width) *width = IMAGE_INSTANCE_WIDTH (ii); if (height) *height = IMAGE_INSTANCE_HEIGHT (ii); - if (IMAGE_INSTANCE_SUBWINDOW_V_RESIZEP (ii) + if (IMAGE_INSTANCE_SUBCONTROL_V_RESIZEP (ii) || - IMAGE_INSTANCE_SUBWINDOW_H_RESIZEP (ii)) + IMAGE_INSTANCE_SUBCONTROL_H_RESIZEP (ii)) { /* .. then try device specific methods ... */ meths = decode_device_ii_format (image_instance_device (image_instance), ＠＠ -569,9 +576,9 ＠＠ IMAGE_INSTANCE_WIDGET_FACE (ii), &w, &h, domain); /* Adjust the size for borders. */ - if (IMAGE_INSTANCE_SUBWINDOW_H_RESIZEP (ii)) + if (IMAGE_INSTANCE_SUBCONTROL_H_RESIZEP (ii)) *width = w + 2 * widget_instance_border_width (ii); - if (IMAGE_INSTANCE_SUBWINDOW_V_RESIZEP (ii)) + if (IMAGE_INSTANCE_SUBCONTROL_V_RESIZEP (ii)) *height = h + 2 * widget_instance_border_width (ii); } } ＠＠ -598,8 +605,8 ＠＠ int width, int height, int xoffset, int yoffset, Lisp_Object domain) { - Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance); - struct image_instantiator_methods* meths; + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + struct image_instantiator_methods *meths; /* .. then try device specific methods ... */ meths = decode_device_ii_format (image_instance_device (image_instance), ＠＠ -675,7 +682,6 ＠＠ static void initialize_widget_image_instance (Lisp_Image_Instance *ii, Lisp_Object type) { - /* initialize_subwindow_image_instance (ii);*/ IMAGE_INSTANCE_WIDGET_TYPE (ii) = type; IMAGE_INSTANCE_WIDGET_PROPS (ii) = Qnil; SET_IMAGE_INSTANCE_WIDGET_FACE (ii, Qnil); ＠＠ -684,11 +690,11 ＠＠ IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii) = Qnil; IMAGE_INSTANCE_WIDGET_WIDTH_SUBR (ii) = Qnil; IMAGE_INSTANCE_WIDGET_HEIGHT_SUBR (ii) = Qnil; - IMAGE_INSTANCE_SUBWINDOW_H_RESIZEP (ii) = 1; - IMAGE_INSTANCE_SUBWINDOW_V_RESIZEP (ii) = 1; - IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) = LAYOUT_HORIZONTAL; - IMAGE_INSTANCE_SUBWINDOW_H_JUSTIFY (ii) = 0; - IMAGE_INSTANCE_SUBWINDOW_V_JUSTIFY (ii) = 0; + IMAGE_INSTANCE_SUBCONTROL_H_RESIZEP (ii) = 1; + IMAGE_INSTANCE_SUBCONTROL_V_RESIZEP (ii) = 1; + IMAGE_INSTANCE_SUBCONTROL_ORIENT (ii) = LAYOUT_HORIZONTAL; + IMAGE_INSTANCE_SUBCONTROL_H_JUSTIFY (ii) = 0; + IMAGE_INSTANCE_SUBCONTROL_V_JUSTIFY (ii) = 0; } /* Instantiate a button widget. Unfortunately instantiated widgets are ＠＠ -711,12 +717,13 ＠＠ 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 tag = find_keyword_in_vector (instantiator, Q_tag); Lisp_Object desc = find_keyword_in_vector (instantiator, Q_descriptor); Lisp_Object glyph = find_keyword_in_vector (instantiator, Q_image); Lisp_Object items = find_keyword_in_vector (instantiator, Q_items); Lisp_Object orient = find_keyword_in_vector (instantiator, Q_orientation); Lisp_Object mwidth = find_keyword_in_vector (instantiator, Q_margin_width); - Lisp_Object ifocus = find_keyword_in_vector (instantiator, Q_initial_focus); + Lisp_Object focus = find_keyword_in_vector (instantiator, Q_focus); int pw=0, ph=0, tw=0, th=0; /* this just does pixel type sizing */ ＠＠ -755,7 +762,7 ＠＠ /* Pick up the orientation before we do our first layout. */ if (EQ (orient, Qleft) || EQ (orient, Qright) || EQ (orient, Qvertical)) - IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) = LAYOUT_VERTICAL; + IMAGE_INSTANCE_SUBCONTROL_ORIENT (ii) = LAYOUT_VERTICAL; /* parse more gui items out of the properties */ if (!NILP (items) && !EQ (IMAGE_INSTANCE_WIDGET_TYPE (ii), Qlayout) ＠＠ -777,13 +784,13 ＠＠ else { pw = XINT (pixwidth); - IMAGE_INSTANCE_SUBWINDOW_H_RESIZEP (ii) = 0; + IMAGE_INSTANCE_SUBCONTROL_H_RESIZEP (ii) = 0; } } else if (!NILP (width)) { tw = XINT (width); - IMAGE_INSTANCE_SUBWINDOW_H_RESIZEP (ii) = 0; + IMAGE_INSTANCE_SUBCONTROL_H_RESIZEP (ii) = 0; } if (!NILP (pixheight)) ＠＠ -793,13 +800,13 ＠＠ else { ph = XINT (pixheight); - IMAGE_INSTANCE_SUBWINDOW_V_RESIZEP (ii) = 0; + IMAGE_INSTANCE_SUBCONTROL_V_RESIZEP (ii) = 0; } } else if (!NILP (height) && XINT (height) > 1) { th = XINT (height); - IMAGE_INSTANCE_SUBWINDOW_V_RESIZEP (ii) = 0; + IMAGE_INSTANCE_SUBCONTROL_V_RESIZEP (ii) = 0; } /* Taking the default face information when the user has specified ＠＠ -841,18 +848,21 ＠＠ if (!NILP (glyph)) { if (!pw) - pw = glyph_width (glyph, image_instance) + 2 * widget_instance_border_width (ii); + pw = glyph_width (glyph, domain, image_instance) + + 2 * widget_instance_border_width (ii); if (!ph) - ph = glyph_height (glyph, image_instance) + 2 * widget_instance_border_width (ii); - IMAGE_INSTANCE_SUBWINDOW_V_RESIZEP (ii) = 0; - IMAGE_INSTANCE_SUBWINDOW_H_RESIZEP (ii) = 0; + ph = glyph_height (glyph, domain, image_instance) + + 2 * widget_instance_border_width (ii); + IMAGE_INSTANCE_SUBCONTROL_V_RESIZEP (ii) = 0; + IMAGE_INSTANCE_SUBCONTROL_H_RESIZEP (ii) = 0; } /* Pick up the margin width. */ if (!NILP (mwidth)) IMAGE_INSTANCE_MARGIN_WIDTH (ii) = XINT (mwidth); - IMAGE_INSTANCE_WANTS_INITIAL_FOCUS (ii) = !NILP (ifocus); + IMAGE_INSTANCE_WIDGET_WANTS_FOCUS (ii) = !NILP (focus); + IMAGE_INSTANCE_WIDGET_TAG (ii) = tag; /* Layout for the layout widget is premature at this point since the children will not have been instantiated. We can't instantiate ＠＠ -884,7 +894,7 ＠＠ depending on the type of button. */ static void button_query_geometry (Lisp_Object image_instance, - int* width, int* height, + int *width, int *height, enum image_instance_geometry UNUSED (disp), Lisp_Object domain) { ＠＠ -894,7 +904,7 ＠＠ IMAGE_INSTANCE_WIDGET_FACE (ii), &w, &h, domain); /* Adjust the size for borders. */ - if (IMAGE_INSTANCE_SUBWINDOW_H_RESIZEP (ii)) + if (IMAGE_INSTANCE_SUBCONTROL_H_RESIZEP (ii)) { *width = w + 3 * widget_instance_border_width (ii); ＠＠ -904,7 +914,7 ＠＠ /* This is an approximation to the size of the actual button bit. */ *width += 12; } - if (IMAGE_INSTANCE_SUBWINDOW_V_RESIZEP (ii)) + if (IMAGE_INSTANCE_SUBCONTROL_V_RESIZEP (ii)) *height = h + 3 * widget_instance_border_width (ii); } ＠＠ -921,16 +931,16 ＠＠ IMAGE_INSTANCE_WIDGET_FACE (ii), &w, &h, domain); /* Adjust the size for borders. */ - if (IMAGE_INSTANCE_SUBWINDOW_H_RESIZEP (ii)) + if (IMAGE_INSTANCE_SUBCONTROL_H_RESIZEP (ii)) *width = w + 4 * widget_instance_border_width (ii); - if (IMAGE_INSTANCE_SUBWINDOW_V_RESIZEP (ii)) + if (IMAGE_INSTANCE_SUBCONTROL_V_RESIZEP (ii)) *height = h + 4 * widget_instance_border_width (ii); } /* tree-view geometry - get the height right */ static void tree_view_query_geometry (Lisp_Object image_instance, - int* width, int* height, + int *width, int *height, enum image_instance_geometry UNUSED (disp), Lisp_Object domain) { ＠＠ -959,7 +969,7 ＠＠ items and text therein in the tab control. */ static void tab_control_query_geometry (Lisp_Object image_instance, - int* width, int* height, + int *width, int *height, enum image_instance_geometry UNUSED (disp), Lisp_Object domain) { ＠＠ -986,7 +996,7 ＠＠ } /* Fixup returned values depending on orientation. */ - if (IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii)) + if (IMAGE_INSTANCE_SUBCONTROL_ORIENT (ii)) { if (height) *height = tw; if (width) *width = th; ＠＠ -1089,7 +1099,8 ＠＠ /* Update the instances in the layout. */ static void -layout_update (Lisp_Object image_instance, Lisp_Object instantiator) +layout_update (Lisp_Object image_instance, Lisp_Object instantiator, + Lisp_Object domain) { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object items = find_keyword_in_vector (instantiator, Q_items); ＠＠ -1099,47 +1110,48 ＠＠ Lisp_Object vjustify = find_keyword_in_vector (instantiator, Q_vertically_justify); Lisp_Object border = Qnil; Lisp_Object children = IMAGE_INSTANCE_LAYOUT_CHILDREN (ii); - int structure_changed = 0; struct gcpro gcpro1; + Lisp_Object newkids = Qnil; + + /* We want to avoid consing if we can, and reuse as many existing instances + as possible. */ + + GCPRO1 (newkids); /* Pick up horizontal justification, left is the default.*/ if (!NILP (hjustify)) { if (EQ (hjustify, Qright) || EQ (hjustify, Qbottom)) - IMAGE_INSTANCE_SUBWINDOW_H_JUSTIFY (ii) = LAYOUT_JUSTIFY_RIGHT; + IMAGE_INSTANCE_SUBCONTROL_H_JUSTIFY (ii) = LAYOUT_JUSTIFY_RIGHT; else if (EQ (hjustify, Qcenter)) - IMAGE_INSTANCE_SUBWINDOW_H_JUSTIFY (ii) = LAYOUT_JUSTIFY_CENTER; + IMAGE_INSTANCE_SUBCONTROL_H_JUSTIFY (ii) = LAYOUT_JUSTIFY_CENTER; } /* If not set use general justification. */ else if (!NILP (justify)) { if (EQ (justify, Qright) || EQ (justify, Qbottom)) - IMAGE_INSTANCE_SUBWINDOW_H_JUSTIFY (ii) = LAYOUT_JUSTIFY_RIGHT; + IMAGE_INSTANCE_SUBCONTROL_H_JUSTIFY (ii) = LAYOUT_JUSTIFY_RIGHT; else if (EQ (justify, Qcenter)) - IMAGE_INSTANCE_SUBWINDOW_H_JUSTIFY (ii) = LAYOUT_JUSTIFY_CENTER; + IMAGE_INSTANCE_SUBCONTROL_H_JUSTIFY (ii) = LAYOUT_JUSTIFY_CENTER; } /* Pick up vertical justification, top is the default. */ if (!NILP (vjustify)) { if (EQ (vjustify, Qright) || EQ (vjustify, Qbottom)) - IMAGE_INSTANCE_SUBWINDOW_V_JUSTIFY (ii) = LAYOUT_JUSTIFY_BOTTOM; + IMAGE_INSTANCE_SUBCONTROL_V_JUSTIFY (ii) = LAYOUT_JUSTIFY_BOTTOM; else if (EQ (vjustify, Qcenter)) - IMAGE_INSTANCE_SUBWINDOW_V_JUSTIFY (ii) = LAYOUT_JUSTIFY_CENTER; + IMAGE_INSTANCE_SUBCONTROL_V_JUSTIFY (ii) = LAYOUT_JUSTIFY_CENTER; } /* If not set use general justification. */ else if (!NILP (justify)) { if (EQ (justify, Qright) || EQ (justify, Qbottom)) - IMAGE_INSTANCE_SUBWINDOW_V_JUSTIFY (ii) = LAYOUT_JUSTIFY_BOTTOM; + IMAGE_INSTANCE_SUBCONTROL_V_JUSTIFY (ii) = LAYOUT_JUSTIFY_BOTTOM; else if (EQ (justify, Qcenter)) - IMAGE_INSTANCE_SUBWINDOW_V_JUSTIFY (ii) = LAYOUT_JUSTIFY_CENTER; + IMAGE_INSTANCE_SUBCONTROL_V_JUSTIFY (ii) = LAYOUT_JUSTIFY_CENTER; } - /* We want to avoid consing if we can. This is quite awkward because - we have to deal with the border as well as the items. */ - GCPRO1 (border); - if (INTP (IMAGE_INSTANCE_LAYOUT_BORDER (ii))) { border = XCAR (children); ＠＠ -1157,23 +1169,14 ＠＠ /* We are going to be sneaky here and add the border text as just another child, the layout and output routines don't know this and will just display at the offsets we prescribe. */ - if (!NILP (border)) - call3 (Qset_glyph_image, border, border_inst, - IMAGE_INSTANCE_DOMAIN (ii)); - else - { - border = Fcons (call1 (Qmake_glyph, border_inst), Qnil); - structure_changed = 1; - } + newkids = Fcons (overwrite_image_instance + /* We set the parents below */ + (border, border_inst, Qnil, domain, Qnil, Qnil), + newkids); IMAGE_INSTANCE_LAYOUT_BORDER (ii) = make_int (0); } else { - if (!NILP (border)) - { - border = Qnil; - structure_changed = 1; - } if (EQ (border_inst, Qt)) IMAGE_INSTANCE_LAYOUT_BORDER (ii) = Qetched_in; else ＠＠ -1182,34 +1185,32 ＠＠ } /* Pick up the sub-widgets. */ - if (!NILP (items)) - { - int len1, len2; - GET_LIST_LENGTH (items, len1); - GET_LIST_LENGTH (children, len2); - /* The structure hasn't changed so just update the images. */ - if (!structure_changed && len1 == len2) - { - /* Pick up the sub-widgets. */ - for (; !NILP (children); children = XCDR (children), items = XCDR (items)) - { - call3 (Qset_glyph_image, XCAR (children), XCAR (items), - IMAGE_INSTANCE_DOMAIN (ii)); - } - } - /* The structure has changed so start over. */ - else - { - /* Instantiate any new glyphs. */ - for (; !NILP (items); items = XCDR (items)) - { - /* #### We really want to use call_with_suspended_errors - here, but it won't allow us to call lisp. */ - border = Fcons (call1 (Qmake_glyph, XCAR (items)), border); - } - IMAGE_INSTANCE_LAYOUT_CHILDREN (ii) = Fnreverse (border); - } - } + { + /* Overwrite as many items as possible */ + LIST_LOOP_2 (item, items) + { + newkids = Fcons (overwrite_image_instance + (!NILP (children) ? XCAR (children) : Qnil, item, + /* We set the parents below */ + Qnil, domain, Qnil, Qnil), + newkids); + if (!NILP (children)) + children = XCDR (children); + } + newkids = Fnreverse (newkids); + /* Disconnect the old instances and connect the new ones */ + { + LIST_LOOP_2 (child, IMAGE_INSTANCE_LAYOUT_CHILDREN (ii)) + XIMAGE_INSTANCE_PARENT (child) = Qnil; + } + { + LIST_LOOP_2 (child, newkids) + XIMAGE_INSTANCE_PARENT (child) = image_instance; + } + IMAGE_INSTANCE_LAYOUT_CHILDREN (ii) = + Freplace_list (IMAGE_INSTANCE_LAYOUT_CHILDREN (ii), newkids); + free_list (newkids); + } UNGCPRO; } ＠＠ -1230,13 +1231,13 ＠＠ if (NILP (orient)) { - IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) = LAYOUT_VERTICAL; + IMAGE_INSTANCE_SUBCONTROL_ORIENT (ii) = LAYOUT_VERTICAL; } /* Get child glyphs and finish instantiation. We can't do image instance children yet as we might not have a containing window. */ - layout_update (image_instance, instantiator); + layout_update (image_instance, instantiator, domain); } static void ＠＠ -1317,9 +1318,9 ＠＠ /* Query the geometry of a layout widget. */ static void -layout_query_geometry (Lisp_Object image_instance, int* width, - int* height, enum image_instance_geometry disp, - Lisp_Object UNUSED (domain)) +layout_query_geometry (Lisp_Object image_instance, int *width, + int *height, enum image_instance_geometry disp, + Lisp_Object domain) { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object items = IMAGE_INSTANCE_LAYOUT_CHILDREN (ii), rest; ＠＠ -1335,9 +1336,9 ＠＠ if (height) *height = IMAGE_INSTANCE_HEIGHT (ii); /* If we are not allowed to dynamically size then return. */ - if (!IMAGE_INSTANCE_SUBWINDOW_V_RESIZEP (ii) + if (!IMAGE_INSTANCE_SUBCONTROL_V_RESIZEP (ii) && - !IMAGE_INSTANCE_SUBWINDOW_H_RESIZEP (ii)) + !IMAGE_INSTANCE_SUBCONTROL_H_RESIZEP (ii)) return; luh = widget_logical_unit_height (ii); ＠＠ -1345,11 +1346,11 ＠＠ /* Pick up the border text if we have one. */ if (INTP (IMAGE_INSTANCE_LAYOUT_BORDER (ii))) { - glyph_query_geometry (XCAR (items), &gwidth, &gheight, disp, - image_instance); + image_instance_query_geometry (XCAR (items), &gwidth, &gheight, disp, + domain); ph_adjust = gheight; /* Include text width in vertical layouts. */ - if (IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) == LAYOUT_VERTICAL) + if (IMAGE_INSTANCE_SUBCONTROL_ORIENT (ii) == LAYOUT_VERTICAL) maxpw = gwidth + BORDER_FIDDLE_FACTOR; items = XCDR (items); } ＠＠ -1357,11 +1358,11 ＠＠ /* Flip through the items to work out how much stuff we have to display */ LIST_LOOP (rest, items) { - Lisp_Object glyph = XCAR (rest); - glyph_query_geometry (glyph, &gwidth, &gheight, disp, image_instance); + image_instance_query_geometry (XCAR (rest), &gwidth, &gheight, disp, + domain); nitems ++; - if (IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) == LAYOUT_HORIZONTAL) + if (IMAGE_INSTANCE_SUBCONTROL_ORIENT (ii) == LAYOUT_HORIZONTAL) { maxph = max (maxph, gheight); maxpw += gwidth; ＠＠ -1375,7 +1376,7 ＠＠ /* Work out minimum space we need to fit all the items. This could have been fixed by the user. */ - if (IMAGE_INSTANCE_SUBWINDOW_H_RESIZEP (ii)) + if (IMAGE_INSTANCE_SUBCONTROL_H_RESIZEP (ii)) { if (!NILP (IMAGE_INSTANCE_WIDGET_WIDTH_SUBR (ii))) { ＠＠ -1384,7 +1385,7 ＠＠ if (INTP (dynamic_width)) *width = XINT (dynamic_width); } - else if (IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) == LAYOUT_HORIZONTAL) + else if (IMAGE_INSTANCE_SUBCONTROL_ORIENT (ii) == LAYOUT_HORIZONTAL) { *width = maxpw + ((nitems + 1) * widget_instance_border_width (ii) + IMAGE_INSTANCE_MARGIN_WIDTH (ii)) * 2; ＠＠ -1397,7 +1398,7 ＠＠ } /* Work out vertical spacings. */ - if (IMAGE_INSTANCE_SUBWINDOW_V_RESIZEP (ii)) + if (IMAGE_INSTANCE_SUBCONTROL_V_RESIZEP (ii)) { if (!NILP (IMAGE_INSTANCE_WIDGET_HEIGHT_SUBR (ii))) { ＠＠ -1406,11 +1407,11 ＠＠ if (INTP (dynamic_height)) *height = XINT (dynamic_height); } - else if (IMAGE_INSTANCE_SUBWINDOW_LOGICAL_LAYOUT (ii)) + else if (IMAGE_INSTANCE_SUBCONTROL_LOGICAL_LAYOUT (ii)) { *height = nitems * luh + ph_adjust; } - else if (IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) == LAYOUT_VERTICAL) + else if (IMAGE_INSTANCE_SUBCONTROL_ORIENT (ii) == LAYOUT_VERTICAL) { *height = maxph + ((nitems + 1) * widget_instance_border_width (ii) + IMAGE_INSTANCE_MARGIN_WIDTH (ii)) * 2 + ph_adjust; ＠＠ -1429,7 +1430,7 ＠＠ int layout_layout (Lisp_Object image_instance, int width, int height, int UNUSED (xoffset), int yoffset, - Lisp_Object UNUSED (domain)) + Lisp_Object domain) { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object rest; ＠＠ -1458,8 +1459,8 ＠＠ { Lisp_Object border = XCAR (items); items = XCDR (items); - glyph_query_geometry (border, &gwidth, &gheight, - IMAGE_DESIRED_GEOMETRY, image_instance); + image_instance_query_geometry (border, &gwidth, &gheight, + IMAGE_DESIRED_GEOMETRY, domain); /* The vertical offset for subsequent items is the full height of the border glyph. */ ph_adjust = gheight; ＠＠ -1467,19 +1468,17 ＠＠ IMAGE_INSTANCE_LAYOUT_BORDER (ii) = make_int (gheight / 2); /* #### Really, what should this be? */ - glyph_do_layout (border, gwidth, gheight, BORDER_FIDDLE_FACTOR, 0, - image_instance); + image_instance_layout (border, gwidth, gheight, BORDER_FIDDLE_FACTOR, 0, + domain); } /* Flip through the items to work out how much stuff we have to display. */ LIST_LOOP (rest, items) { - Lisp_Object glyph = XCAR (rest); - - glyph_query_geometry (glyph, &gwidth, &gheight, - IMAGE_DESIRED_GEOMETRY, image_instance); + image_instance_query_geometry (XCAR (rest), &gwidth, &gheight, + IMAGE_DESIRED_GEOMETRY, domain); nitems ++; - if (IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) + if (IMAGE_INSTANCE_SUBCONTROL_ORIENT (ii) == LAYOUT_HORIZONTAL) { maxph = max (maxph, gheight); ＠＠ -1498,7 +1497,7 ＠＠ just provide default spacing and will let the output routines clip. */ horiz_spacing = widget_spacing (IMAGE_INSTANCE_DOMAIN (ii)); - else if (IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) + else if (IMAGE_INSTANCE_SUBCONTROL_ORIENT (ii) == LAYOUT_HORIZONTAL) /* We have a larger area to display in so distribute the space evenly. */ ＠＠ -1518,10 +1517,10 ＠＠ accommodate it. */ if (height < maxph) vert_spacing = widget_spacing (IMAGE_INSTANCE_DOMAIN (ii)) * 2; - else if (IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) + else if (IMAGE_INSTANCE_SUBCONTROL_ORIENT (ii) == LAYOUT_VERTICAL) { - if (!IMAGE_INSTANCE_SUBWINDOW_V_CENTERED (ii)) + if (!IMAGE_INSTANCE_SUBCONTROL_V_CENTERED (ii)) vert_spacing = widget_spacing (IMAGE_INSTANCE_DOMAIN (ii)) * 2; else vert_spacing = (height - (maxph + ph_adjust + ＠＠ -1540,37 +1539,35 ＠＠ border glyph. */ LIST_LOOP (rest, items) { - Lisp_Object glyph = XCAR (rest); - - glyph_query_geometry (glyph, &gwidth, &gheight, - IMAGE_DESIRED_GEOMETRY, image_instance); + image_instance_query_geometry (XCAR (rest), &gwidth, &gheight, + IMAGE_DESIRED_GEOMETRY, domain); - if (IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) == LAYOUT_HORIZONTAL) + if (IMAGE_INSTANCE_SUBCONTROL_ORIENT (ii) == LAYOUT_HORIZONTAL) { - if (IMAGE_INSTANCE_SUBWINDOW_BOTTOM_JUSTIFIED (ii)) + if (IMAGE_INSTANCE_SUBCONTROL_BOTTOM_JUSTIFIED (ii)) y = height - (gheight + vert_spacing); - else if (IMAGE_INSTANCE_SUBWINDOW_V_CENTERED (ii)) + else if (IMAGE_INSTANCE_SUBCONTROL_V_CENTERED (ii)) y = (height - gheight) / 2; } else { - if (IMAGE_INSTANCE_SUBWINDOW_RIGHT_JUSTIFIED (ii)) + if (IMAGE_INSTANCE_SUBCONTROL_RIGHT_JUSTIFIED (ii)) x = width - (gwidth + horiz_spacing); - else if (IMAGE_INSTANCE_SUBWINDOW_H_CENTERED (ii)) + else if (IMAGE_INSTANCE_SUBCONTROL_H_CENTERED (ii)) x = (width - gwidth) / 2; } /* Now layout subwidgets if they require it. */ - glyph_do_layout (glyph, gwidth, gheight, x, y, image_instance); + image_instance_layout (XCAR (rest), gwidth, gheight, x, y, domain); - if (IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) == LAYOUT_HORIZONTAL) + if (IMAGE_INSTANCE_SUBCONTROL_ORIENT (ii) == LAYOUT_HORIZONTAL) { x += (gwidth + horiz_spacing); } else { y += (gheight + vert_spacing); - if (!IMAGE_INSTANCE_SUBWINDOW_V_CENTERED (ii)) + if (!IMAGE_INSTANCE_SUBCONTROL_V_CENTERED (ii)) { /* justified, vertical layout, try and align on logical unit boundaries. */ ＠＠ -1612,7 +1609,7 ＠＠ int width, int height, int xoffset, int yoffset, Lisp_Object domain) { - Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance); + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object rest; /* The first time this gets called, the layout will be only ＠＠ -1621,8 +1618,8 ＠＠ if (!IMAGE_INSTANCE_INITIALIZED (ii)) return 0; - /* Defining this overrides the default layout_layout so we first have to call that to get - suitable instances and values set up. */ + /* Defining this overrides the default layout_layout so we first have to + call that to get suitable instances and values set up. */ layout_layout (image_instance, width, height, xoffset, yoffset, domain); LIST_LOOP (rest, IMAGE_INSTANCE_LAYOUT_CHILDREN (ii)) ＠＠ -1633,7 +1630,7 ＠＠ dga.width = IMAGE_INSTANCE_WIDTH (ii); dga.height = IMAGE_INSTANCE_HEIGHT (ii); - map_subwindow (XCAR (rest), + map_subcontrol (XCAR (rest), IMAGE_INSTANCE_XOFFSET (ii), IMAGE_INSTANCE_YOFFSET (ii), &dga); } ＠＠ -1719,7 +1716,7 ＠＠ DEFSUBR (Fwidget_logical_to_character_width); } -#define VALID_GUI_KEYWORDS(type) do { \ +#define VALID_FOCUS_WIDGET_KEYWORDS(type) do { \ IIFORMAT_VALID_NONCOPY_KEYWORD (type, Q_active, check_valid_anything); \ IIFORMAT_VALID_KEYWORD (type, Q_suffix, check_valid_anything); \ IIFORMAT_VALID_KEYWORD (type, Q_keys, check_valid_string); \ ＠＠ -1728,36 +1725,38 ＠＠ IIFORMAT_VALID_KEYWORD (type, Q_filter, check_valid_anything); \ IIFORMAT_VALID_KEYWORD (type, Q_config, check_valid_symbol); \ IIFORMAT_VALID_KEYWORD (type, Q_included, check_valid_anything); \ - IIFORMAT_VALID_KEYWORD (type, Q_initial_focus, check_valid_anything); \ + IIFORMAT_VALID_KEYWORD (type, Q_focus, check_valid_anything); \ IIFORMAT_VALID_KEYWORD (type, Q_key_sequence, check_valid_string); \ IIFORMAT_VALID_KEYWORD (type, Q_accelerator, check_valid_string); \ IIFORMAT_VALID_KEYWORD (type, Q_label, check_valid_anything); \ IIFORMAT_VALID_NONCOPY_KEYWORD (type, Q_callback, check_valid_callback); \ - IIFORMAT_VALID_NONCOPY_KEYWORD (type, Q_callback_ex, check_valid_callback); \ IIFORMAT_VALID_NONCOPY_KEYWORD (type, Q_descriptor, \ check_valid_string_or_vector); \ } while (0) -#define VALID_WIDGET_KEYWORDS(type) do { \ - IIFORMAT_VALID_KEYWORD (type, Q_width, check_valid_int); \ - IIFORMAT_VALID_KEYWORD (type, Q_height, check_valid_int); \ +#define VALID_WIDGET_PIXEL_DIM_ONLY_KEYWORDS(type) do { \ IIFORMAT_VALID_KEYWORD (type, Q_pixel_width, check_valid_int_or_function); \ IIFORMAT_VALID_KEYWORD (type, Q_pixel_height, check_valid_int_or_function); \ IIFORMAT_VALID_KEYWORD (type, Q_face, check_valid_face); \ + IIFORMAT_VALID_KEYWORD (type, Q_tag, check_valid_symbol); \ } while (0) +#define VALID_WIDGET_KEYWORDS(type) do { \ + VALID_WIDGET_PIXEL_DIM_ONLY_KEYWORDS (type); \ + IIFORMAT_VALID_KEYWORD (type, Q_width, check_valid_int); \ + IIFORMAT_VALID_KEYWORD (type, Q_height, check_valid_int); \ +} while (0) -static void image_instantiator_widget (void) -{ /* we only do this for properties */ +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, update); IIFORMAT_HAS_METHOD (widget, query_geometry); IIFORMAT_HAS_METHOD (widget, layout); -} -static void image_instantiator_buttons (void) -{ INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (button, "button"); IIFORMAT_HAS_SHARED_METHOD (button, validate, widget); IIFORMAT_HAS_SHARED_METHOD (button, possible_dest_types, widget); ＠＠ -1766,75 +1765,53 ＠＠ IIFORMAT_HAS_SHARED_METHOD (button, normalize, widget); IIFORMAT_HAS_SHARED_METHOD (button, governing_domain, subwindow); IIFORMAT_HAS_METHOD (button, query_geometry); + + VALID_WIDGET_KEYWORDS (button); + VALID_FOCUS_WIDGET_KEYWORDS (button); IIFORMAT_VALID_KEYWORD (button, Q_image, check_valid_instantiator); - VALID_WIDGET_KEYWORDS (button); - VALID_GUI_KEYWORDS (button); -} -static void image_instantiator_edit_fields (void) -{ INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (edit_field, "edit-field"); IIFORMAT_HAS_SHARED_METHOD (edit_field, validate, widget); IIFORMAT_HAS_SHARED_METHOD (edit_field, possible_dest_types, widget); IIFORMAT_HAS_SHARED_METHOD (edit_field, instantiate, widget); IIFORMAT_HAS_SHARED_METHOD (edit_field, post_instantiate, widget); IIFORMAT_HAS_SHARED_METHOD (edit_field, governing_domain, subwindow); + IIFORMAT_HAS_METHOD (edit_field, query_geometry); VALID_WIDGET_KEYWORDS (edit_field); - VALID_GUI_KEYWORDS (edit_field); -} + VALID_FOCUS_WIDGET_KEYWORDS (edit_field); -static void image_instantiator_combo_box (void) -{ INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (combo_box, "combo-box"); IIFORMAT_HAS_METHOD (combo_box, validate); IIFORMAT_HAS_SHARED_METHOD (combo_box, possible_dest_types, widget); IIFORMAT_HAS_SHARED_METHOD (combo_box, governing_domain, subwindow); - - VALID_GUI_KEYWORDS (combo_box); - IIFORMAT_VALID_KEYWORD (combo_box, Q_width, check_valid_int); - IIFORMAT_VALID_KEYWORD (combo_box, Q_height, check_valid_int); - IIFORMAT_VALID_KEYWORD (combo_box, Q_pixel_width, - check_valid_int_or_function); - IIFORMAT_VALID_KEYWORD (combo_box, Q_face, check_valid_face); + VALID_WIDGET_KEYWORDS (combo_box); + VALID_FOCUS_WIDGET_KEYWORDS (combo_box); IIFORMAT_VALID_KEYWORD (combo_box, Q_items, check_valid_item_list); -} -static void image_instantiator_scrollbar (void) -{ 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_HAS_SHARED_METHOD (scrollbar, post_instantiate, widget); IIFORMAT_HAS_SHARED_METHOD (scrollbar, governing_domain, subwindow); - VALID_GUI_KEYWORDS (scrollbar); - IIFORMAT_VALID_KEYWORD (scrollbar, Q_pixel_width, - check_valid_int_or_function); - IIFORMAT_VALID_KEYWORD (scrollbar, Q_pixel_height, - check_valid_int_or_function); - IIFORMAT_VALID_KEYWORD (scrollbar, Q_face, check_valid_face); -} + VALID_WIDGET_PIXEL_DIM_ONLY_KEYWORDS (scrollbar); + VALID_FOCUS_WIDGET_KEYWORDS (scrollbar); -static void image_instantiator_progress_guage (void) -{ INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (progress_gauge, "progress-gauge"); IIFORMAT_HAS_SHARED_METHOD (progress_gauge, validate, widget); IIFORMAT_HAS_SHARED_METHOD (progress_gauge, possible_dest_types, widget); IIFORMAT_HAS_SHARED_METHOD (progress_gauge, instantiate, widget); IIFORMAT_HAS_SHARED_METHOD (progress_gauge, post_instantiate, widget); IIFORMAT_HAS_SHARED_METHOD (progress_gauge, governing_domain, subwindow); - VALID_WIDGET_KEYWORDS (progress_gauge); - VALID_GUI_KEYWORDS (progress_gauge); + VALID_WIDGET_KEYWORDS (progress_gauge); + VALID_FOCUS_WIDGET_KEYWORDS (progress_gauge); IIFORMAT_VALID_KEYWORD (progress_gauge, Q_value, check_valid_int); -} -static void image_instantiator_tree_view (void) -{ INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (tree_view, "tree-view"); IIFORMAT_HAS_SHARED_METHOD (tree_view, validate, combo_box); IIFORMAT_HAS_SHARED_METHOD (tree_view, possible_dest_types, widget); ＠＠ -1842,13 +1819,11 ＠＠ IIFORMAT_HAS_SHARED_METHOD (tree_view, post_instantiate, widget); IIFORMAT_HAS_SHARED_METHOD (tree_view, governing_domain, subwindow); IIFORMAT_HAS_METHOD (tree_view, query_geometry); + VALID_WIDGET_KEYWORDS (tree_view); - VALID_GUI_KEYWORDS (tree_view); + VALID_FOCUS_WIDGET_KEYWORDS (tree_view); IIFORMAT_VALID_KEYWORD (tree_view, Q_items, check_valid_item_list); -} -static void image_instantiator_tab_control (void) -{ INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (tab_control, "tab-control"); IIFORMAT_HAS_SHARED_METHOD (tab_control, validate, combo_box); IIFORMAT_HAS_SHARED_METHOD (tab_control, possible_dest_types, widget); ＠＠ -1856,25 +1831,24 ＠＠ IIFORMAT_HAS_SHARED_METHOD (tab_control, post_instantiate, widget); IIFORMAT_HAS_SHARED_METHOD (tab_control, governing_domain, subwindow); IIFORMAT_HAS_METHOD (tab_control, query_geometry); + VALID_WIDGET_KEYWORDS (tab_control); - VALID_GUI_KEYWORDS (tab_control); + VALID_FOCUS_WIDGET_KEYWORDS (tab_control); IIFORMAT_VALID_KEYWORD (tab_control, Q_orientation, check_valid_tab_orientation); IIFORMAT_VALID_KEYWORD (tab_control, Q_items, check_valid_item_list); -} -static void image_instantiator_labels (void) -{ INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (label, "label"); IIFORMAT_HAS_SHARED_METHOD (label, possible_dest_types, widget); IIFORMAT_HAS_SHARED_METHOD (label, instantiate, widget); IIFORMAT_HAS_SHARED_METHOD (label, post_instantiate, widget); IIFORMAT_HAS_SHARED_METHOD (label, governing_domain, subwindow); + VALID_WIDGET_KEYWORDS (label); IIFORMAT_VALID_KEYWORD (label, Q_descriptor, check_valid_string); -} #define VALID_LAYOUT_KEYWORDS(layout) \ +do { \ VALID_WIDGET_KEYWORDS (layout); \ IIFORMAT_VALID_KEYWORD (layout, Q_orientation, check_valid_orientation); \ IIFORMAT_VALID_KEYWORD (layout, Q_justify, check_valid_justification); \ ＠＠ -1883,10 +1857,9 ＠＠ IIFORMAT_VALID_KEYWORD (layout, Q_border, check_valid_border); \ IIFORMAT_VALID_KEYWORD (layout, Q_margin_width, check_valid_int); \ IIFORMAT_VALID_KEYWORD (layout, Q_items, \ - check_valid_instantiator_list) + check_valid_instantiator_list); \ +} while (0) -static void image_instantiator_layout (void) -{ INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (layout, "layout"); IIFORMAT_HAS_SHARED_METHOD (layout, possible_dest_types, widget); IIFORMAT_HAS_METHOD (layout, instantiate); ＠＠ -1898,12 +1871,9 ＠＠ IIFORMAT_HAS_METHOD (layout, update); IIFORMAT_HAS_METHOD (layout, property); - VALID_GUI_KEYWORDS (layout); + VALID_FOCUS_WIDGET_KEYWORDS (layout); VALID_LAYOUT_KEYWORDS (layout); -} -static void image_instantiator_native_layout (void) -{ INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (native_layout, "native-layout"); IIFORMAT_HAS_SHARED_METHOD (native_layout, possible_dest_types, widget); IIFORMAT_HAS_SHARED_METHOD (native_layout, instantiate, layout); ＠＠ -1915,24 +1885,8 ＠＠ IIFORMAT_HAS_SHARED_METHOD (native_layout, layout, layout); IIFORMAT_HAS_SHARED_METHOD (native_layout, property, layout); - VALID_GUI_KEYWORDS (native_layout); + VALID_FOCUS_WIDGET_KEYWORDS (native_layout); VALID_LAYOUT_KEYWORDS (native_layout); -} - -void -image_instantiator_format_create_glyphs_widget (void) -{ - image_instantiator_widget(); - image_instantiator_buttons(); - image_instantiator_edit_fields(); - image_instantiator_combo_box(); - image_instantiator_scrollbar(); - image_instantiator_progress_guage(); - image_instantiator_tree_view(); - image_instantiator_tab_control(); - image_instantiator_labels(); - image_instantiator_layout(); - image_instantiator_native_layout(); } void 1.82.4.1 +63 -67 XEmacs/xemacs/src/glyphs-x.c Index: glyphs-x.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/glyphs-x.c,v retrieving revision 1.82 retrieving revision 1.82.4.1 diff -u -r1.82 -r1.82.4.1 --- glyphs-x.c 2005/01/24 23:33:58 1.82 +++ glyphs-x.c 2005/02/16 00:43:22 1.82.4.1 ＠＠ -2,7 +2,7 ＠＠ Copyright (C) 1993, 1994 Free Software Foundation, Inc. Copyright (C) 1995 Board of Trustees, University of Illinois. Copyright (C) 1995 Tinker Systems - Copyright (C) 1995, 1996, 2001, 2002, 2003, 2004 Ben Wing + Copyright (C) 1995, 1996, 2001, 2002, 2003, 2004, 2005 Ben Wing Copyright (C) 1995 Sun Microsystems Copyright (C) 1999, 2000, 2002 Andy Piper ＠＠ -139,16 +139,14 ＠＠ Lisp_Object domain); #ifdef HAVE_X_WIDGETS -static void update_widget_face (widget_value* wv, - Lisp_Image_Instance* ii, Lisp_Object domain); -static void update_tab_widget_face (widget_value* wv, - Lisp_Image_Instance* ii, +static void update_widget_face (widget_value *wv, + Lisp_Image_Instance *ii, Lisp_Object domain); +static void update_tab_widget_face (widget_value *wv, + Lisp_Image_Instance *ii, Lisp_Object domain); #endif -void emacs_Xt_handle_widget_losing_focus (struct frame* f, - Widget losing_widget); -void emacs_Xt_enqueue_focus_event (Widget wants_it, Lisp_Object frame, - int in_p); +void Xt_handle_widget_losing_focus (struct frame *f, Widget losing_widget); +void Xt_enqueue_focus_event (Widget wants_it, Lisp_Object frame, int in_p); #include "bitmaps.h" ＠＠ -396,7 +394,7 ＠＠ #ifdef HAVE_X_WIDGETS else if (IMAGE_INSTANCE_TYPE (p) == IMAGE_WIDGET) { - if (IMAGE_INSTANCE_SUBWINDOW_ID (p)) + if (IMAGE_INSTANCE_SUBCONTROL_ID (p)) { #ifdef DEBUG_WIDGETS debug_widget_instances--; ＠＠ -415,9 +413,9 ＠＠ #endif else if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW) { - if (IMAGE_INSTANCE_SUBWINDOW_ID (p)) + if (IMAGE_INSTANCE_SUBCONTROL_ID (p)) XDestroyWindow (dpy, IMAGE_INSTANCE_X_SUBWINDOW_ID (p)); - IMAGE_INSTANCE_SUBWINDOW_ID (p) = 0; + IMAGE_INSTANCE_SUBCONTROL_ID (p) = 0; } else { ＠＠ -559,11 +557,11 ＠＠ /* Check non-absolute pathnames with a directory component relative to the search path; that's the way Xt does it. */ /* #### Unix-specific */ - if (string_byte (name, 0) == '/' || - (string_byte (name, 0) == '.' && - (string_byte (name, 1) == '/' || - (string_byte (name, 1) == '.' && - (string_byte (name, 2) == '/'))))) + if (string_byte_at (name, 0) == '/' || + (string_byte_at (name, 0) == '.' && + (string_byte_at (name, 1) == '/' || + (string_byte_at (name, 1) == '.' && + (string_byte_at (name, 2) == '/'))))) { if (!NILP (Ffile_readable_p (name))) return Fexpand_file_name (name, Qnil); ＠＠ -853,7 +851,7 ＠＠ unsigned long *pixtbl = NULL; int npixels = 0; int slice; - XImage* ximage; + XImage *ximage; for (slice = 0; slice < slices; slice++) { ＠＠ -2012,13 +2010,13 ＠＠  /************************************************************************/ -/* subwindow and widget support */ +/* subwindow and widget support */ /************************************************************************/ /* unmap the image if it is a widget. This is used by redisplay via - redisplay_unmap_subwindows */ + redisplay_unmap_subcontrols */ static void -x_unmap_subwindow (Lisp_Image_Instance *p) +x_unmap_subcontrol (Lisp_Image_Instance *p) { if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW) { ＠＠ -2034,18 +2032,17 ＠＠ /* Since we are being unmapped we want the enclosing frame to get focus. The losing with simple scrolling but is the safest thing to do. */ - emacs_Xt_handle_widget_losing_focus - ( XFRAME (IMAGE_INSTANCE_FRAME (p)), - IMAGE_INSTANCE_X_WIDGET_ID (p)); + Xt_handle_widget_losing_focus (XFRAME (IMAGE_INSTANCE_FRAME (p)), + IMAGE_INSTANCE_X_WIDGET_ID (p)); XtUnmapWidget (IMAGE_INSTANCE_X_CLIPWIDGET (p)); } } -/* map the subwindow. This is used by redisplay via - redisplay_output_subwindow */ +/* map the subcontrol. This is used by redisplay via + redisplay_output_subcontrol */ static void -x_map_subwindow (Lisp_Image_Instance *p, int x, int y, - struct display_glyph_area* dga) +x_map_subcontrol (Lisp_Image_Instance *p, int x, int y, + struct display_glyph_area *dga) { assert (dga->width > 0 && dga->height > 0); if (IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW) ＠＠ -2056,7 +2053,7 ＠＠ x, y, dga->width, dga->height); XMoveWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p), subwindow, -dga->xoffset, -dga->yoffset); - if (!IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (p)) + if (!IMAGE_INSTANCE_SUBCONTROL_DISPLAYEDP (p)) { XMapWindow (IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (p), IMAGE_INSTANCE_X_CLIPWINDOW (p)); ＠＠ -2072,22 +2069,20 ＠＠ dga->width, dga->height, 0); XtMoveWidget (IMAGE_INSTANCE_X_WIDGET_ID (p), -dga->xoffset, -dga->yoffset); - if (!IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (p)) + if (!IMAGE_INSTANCE_SUBCONTROL_DISPLAYEDP (p)) XtMapWidget (IMAGE_INSTANCE_X_CLIPWIDGET (p)); /* See comments in glyphs-msw.c about keyboard focus. */ - if (IMAGE_INSTANCE_WANTS_INITIAL_FOCUS (p)) + if (IMAGE_INSTANCE_WIDGET_WANTS_FOCUS (p)) { /* #### FIXME to pop-up the find dialog we map the text-field seven times! This doesn't show on a fast linux box but does under X on windows. */ - emacs_Xt_enqueue_focus_event (IMAGE_INSTANCE_X_WIDGET_ID (p), - IMAGE_INSTANCE_FRAME (p), 1); + Xt_enqueue_focus_event (IMAGE_INSTANCE_X_WIDGET_ID (p), + IMAGE_INSTANCE_FRAME (p), 1); } } } -/* when you click on a widget you may activate another widget this - needs to be checked and all appropriate widgets updated */ static void x_redisplay_subwindow (Lisp_Image_Instance *p) { ＠＠ -2108,7 +2103,7 ＠＠ { /* This function can GC if IN_REDISPLAY is false. */ #ifdef HAVE_X_WIDGETS - widget_value* wv = 0; + widget_value *wv = 0; /* First get the items if they have changed since this is a structural change. As such it will nuke all added values so we ＠＠ -2155,7 +2150,7 ＠＠ /* Possibly update the text. */ if (IMAGE_INSTANCE_TEXT_CHANGED (p)) { - Extbyte* str; + Extbyte *str; Lisp_Object val = IMAGE_INSTANCE_WIDGET_TEXT (p); LISP_STRING_TO_EXTERNAL (val, str, Qnative); wv->value = str; ＠＠ -2177,7 +2172,7 ＠＠ Lisp_Object sw = wrap_image_instance (p); signal_error (Qinternal_error, - "XEmacs bug: subwindow is deleted", sw); + "XEmacs bug: subcontrol is deleted", sw); } lw_add_widget_value_arg (wv, XtNwidth, ＠＠ -2203,7 +2198,7 ＠＠ #endif } -/* instantiate and x type subwindow */ +/* instantiate an X type subwindow */ static void x_subwindow_instantiate (Lisp_Object image_instance, Lisp_Object UNUSED (instantiator), ＠＠ -2215,7 +2210,7 ＠＠ Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii); Lisp_Object frame = DOMAIN_FRAME (domain); - struct frame* f = XFRAME (frame); + struct frame *f = XFRAME (frame); Display *dpy; Screen *xs; Window pw, win; ＠＠ -2233,7 +2228,7 ＠＠ pw = XtWindow (FRAME_X_TEXT_WIDGET (f)); - ii->data = xnew_and_zero (struct x_subwindow_data); + ii->data = xnew_and_zero (struct x_subcontrol_data); IMAGE_INSTANCE_X_SUBWINDOW_PARENT (ii) = pw; IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY (ii) = DisplayOfScreen (xs); ＠＠ -2255,7 +2250,7 ＠＠ InputOutput, CopyFromParent, valueMask, &xswa); - IMAGE_INSTANCE_SUBWINDOW_ID (ii) = (void*)win; + IMAGE_INSTANCE_SUBCONTROL_ID (ii) = (void *) win; } /* Account for some of the limitations with widget images. */ ＠＠ -2306,7 +2301,7 ＠＠ /************************************************************************/ static void -update_widget_face (widget_value* wv, Lisp_Image_Instance *ii, +update_widget_face (widget_value *wv, Lisp_Image_Instance *ii, Lisp_Object domain) { #ifdef LWLIB_WIDGETS_MOTIF ＠＠ -2348,12 +2343,12 ＠＠ } static void -update_tab_widget_face (widget_value* wv, Lisp_Image_Instance *ii, +update_tab_widget_face (widget_value *wv, Lisp_Image_Instance *ii, Lisp_Object domain) { if (wv->contents) { - widget_value* val = wv->contents, *cur; + widget_value *val = wv->contents, *cur; /* Give each child label the correct foreground color. */ Lisp_Object pixel = FACE_FOREGROUND ＠＠ -2381,19 +2376,19 ＠＠ Lisp_Object UNUSED (pointer_fg), Lisp_Object UNUSED (pointer_bg), int UNUSED (dest_mask), Lisp_Object domain, - const char* type, widget_value* wv) + const char *type, widget_value *wv) { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii), pixel; - struct device* d = XDEVICE (device); + struct device *d = XDEVICE (device); Lisp_Object frame = DOMAIN_FRAME (domain); - struct frame* f = XFRAME (frame); - char* nm=0; + struct frame *f = XFRAME (frame); + char *nm=0; Widget wid; Arg al [32]; int ac = 0; int id = new_lwlib_id (); - widget_value* clip_wv; + widget_value *clip_wv; XColor fcolor, bcolor; if (!DEVICE_X_P (d)) ＠＠ -2407,7 +2402,7 ＠＠ if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii))) LISP_STRING_TO_EXTERNAL (IMAGE_INSTANCE_WIDGET_TEXT (ii), nm, Qnative); - ii->data = xnew_and_zero (struct x_subwindow_data); + ii->data = xnew_and_zero (struct x_subcontrol_data); /* Create a clip window to contain the subwidget. Incredibly the XEmacs manager seems to be the most appropriate widget for ＠＠ -2469,7 +2464,7 ＠＠ IMAGE_INSTANCE_X_CLIPWIDGET (ii), False, 0, popup_selection_callback, 0); - IMAGE_INSTANCE_SUBWINDOW_ID (ii) = (void*)wid; + IMAGE_INSTANCE_SUBCONTROL_ID (ii) = (void*)wid; IMAGE_INSTANCE_X_WIDGET_LWID (ii) = id; /* because the EmacsManager is the widgets parent we have to offset the redisplay of the widget by the amount the text ＠＠ -2495,7 +2490,7 ＠＠ /* get the text from a control */ if (EQ (prop, Q_text)) { - widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii)); + widget_value *wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii)); return build_ext_string (wv->value, Qnative); } return Qunbound; ＠＠ -2526,12 +2521,13 ＠＠ Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii); Lisp_Object glyph = find_keyword_in_vector (instantiator, Q_image); - widget_value* wv = gui_items_to_widget_values (image_instance, gui, 1); + widget_value *wv = gui_items_to_widget_values (image_instance, gui, 1); if (!NILP (glyph)) { if (!IMAGE_INSTANCEP (glyph)) - glyph = glyph_image_instance (glyph, domain, ERROR_ME, 1); + glyph = glyph_image_instance (glyph, domain, image_instance, + ERROR_ME, 1); } x_widget_instantiate (image_instance, instantiator, pointer_fg, ＠＠ -2568,7 +2564,7 ＠＠ { /* This function can GC if IN_REDISPLAY is false. */ Lisp_Image_Instance *p = XIMAGE_INSTANCE (image_instance); - widget_value* wv = + widget_value *wv = gui_items_to_widget_values (image_instance, IMAGE_INSTANCE_WIDGET_ITEMS (p), 1); ＠＠ -2586,7 +2582,7 ＠＠ /* check the state of a button */ if (EQ (prop, Q_selected)) { - widget_value* wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii)); + widget_value *wv = lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii)); if (wv->selected) return Qt; ＠＠ -2605,7 +2601,7 ＠＠ { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii); - widget_value* wv = gui_items_to_widget_values (image_instance, gui, 0); + widget_value *wv = gui_items_to_widget_values (image_instance, gui, 0); x_widget_instantiate (image_instance, instantiator, pointer_fg, pointer_bg, dest_mask, domain, "progress", wv); ＠＠ -2635,7 +2631,7 ＠＠ { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii); - widget_value* wv = gui_items_to_widget_values (image_instance, gui, 0); + widget_value *wv = gui_items_to_widget_values (image_instance, gui, 0); x_widget_instantiate (image_instance, instantiator, pointer_fg, pointer_bg, dest_mask, domain, "text-field", wv); ＠＠ -2649,7 +2645,7 ＠＠ int dest_mask, Lisp_Object domain) { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - widget_value * wv = 0; + widget_value *wv = 0; /* This is not done generically because of sizing problems under mswindows. */ widget_instantiate (image_instance, instantiator, pointer_fg, ＠＠ -2670,7 +2666,7 ＠＠ int dest_mask, Lisp_Object domain) { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - widget_value * wv = + widget_value *wv = gui_items_to_widget_values (image_instance, IMAGE_INSTANCE_WIDGET_ITEMS (ii), 0); update_tab_widget_face (wv, ii, ＠＠ -2710,9 +2706,9 ＠＠ gui_item_list_find_selected (XCDR (IMAGE_INSTANCE_WIDGET_ITEMS (ii))); Arg al [1]; - char* name; + char *name; unsigned int num_children, i; - Widget* children; + Widget *children; LISP_STRING_TO_EXTERNAL (XGUI_ITEM (XCAR (rest))->name, name, Qnative); ＠＠ -2755,7 +2751,7 ＠＠ #### There's actually not much point in doing this here since, colors will have been set appropriately by x_redisplay_widget. */ - widget_value* wv =copy_widget_value_tree + widget_value *wv =copy_widget_value_tree (lw_get_all_values (IMAGE_INSTANCE_X_WIDGET_LWID (ii)), NO_CHANGE); ＠＠ -2777,7 +2773,7 ＠＠ { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii); - widget_value* wv = gui_items_to_widget_values (image_instance, gui, 0); + widget_value *wv = gui_items_to_widget_values (image_instance, gui, 0); x_widget_instantiate (image_instance, instantiator, pointer_fg, pointer_bg, dest_mask, domain, "button", wv); ＠＠ -2809,8 +2805,8 ＠＠ CONSOLE_HAS_METHOD (x, colorize_image_instance); CONSOLE_HAS_METHOD (x, init_image_instance_from_eimage); CONSOLE_HAS_METHOD (x, locate_pixmap_file); - CONSOLE_HAS_METHOD (x, unmap_subwindow); - CONSOLE_HAS_METHOD (x, map_subwindow); + CONSOLE_HAS_METHOD (x, unmap_subcontrol); + CONSOLE_HAS_METHOD (x, map_subcontrol); CONSOLE_HAS_METHOD (x, redisplay_widget); CONSOLE_HAS_METHOD (x, redisplay_subwindow); CONSOLE_HAS_METHOD (x, widget_border_width); 1.5.24.1 +13 -13 XEmacs/xemacs/src/glyphs-x.h Index: glyphs-x.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/glyphs-x.h,v retrieving revision 1.5 retrieving revision 1.5.24.1 diff -u -r1.5 -r1.5.24.1 --- glyphs-x.h 2001/04/12 18:23:52 1.5 +++ glyphs-x.h 2005/02/16 00:43:24 1.5.24.1 ＠＠ -40,7 +40,7 ＠＠ struct x_image_instance_data { - Pixmap* pixmaps; + Pixmap *pixmaps; Cursor cursor; /* If depth>0, then that means that other colors were allocated when ＠＠ -87,7 +87,7 ＠＠ * Subwindow Object * ****************************************************************************/ -struct x_subwindow_data +struct x_subcontrol_data { union { ＠＠ -107,26 +107,26 ＠＠ } data; }; -#define X_SUBWINDOW_INSTANCE_DATA(i) ((struct x_subwindow_data *) (i)->data) +#define X_SUBCONTROL_INSTANCE_DATA(i) ((struct x_subcontrol_data *) (i)->data) #define IMAGE_INSTANCE_X_SUBWINDOW_DISPLAY(i) \ - (X_SUBWINDOW_INSTANCE_DATA (i)->data.sub.display) + (X_SUBCONTROL_INSTANCE_DATA (i)->data.sub.display) #define IMAGE_INSTANCE_X_SUBWINDOW_PARENT(i) \ - (X_SUBWINDOW_INSTANCE_DATA (i)->data.sub.parent_window) + (X_SUBCONTROL_INSTANCE_DATA (i)->data.sub.parent_window) #define IMAGE_INSTANCE_X_CLIPWINDOW(i) \ - (X_SUBWINDOW_INSTANCE_DATA (i)->data.sub.clip_window) + (X_SUBCONTROL_INSTANCE_DATA (i)->data.sub.clip_window) #define IMAGE_INSTANCE_X_WIDGET_XOFFSET(i) \ - (X_SUBWINDOW_INSTANCE_DATA (i)->data.wid.x_offset) + (X_SUBCONTROL_INSTANCE_DATA (i)->data.wid.x_offset) #define IMAGE_INSTANCE_X_WIDGET_YOFFSET(i) \ - (X_SUBWINDOW_INSTANCE_DATA (i)->data.wid.y_offset) + (X_SUBCONTROL_INSTANCE_DATA (i)->data.wid.y_offset) #define IMAGE_INSTANCE_X_WIDGET_LWID(i) \ - (X_SUBWINDOW_INSTANCE_DATA (i)->data.wid.id) + (X_SUBCONTROL_INSTANCE_DATA (i)->data.wid.id) #define IMAGE_INSTANCE_X_CLIPWIDGET(i) \ - (X_SUBWINDOW_INSTANCE_DATA (i)->data.wid.clip_window) + (X_SUBCONTROL_INSTANCE_DATA (i)->data.wid.clip_window) #define IMAGE_INSTANCE_X_SUBWINDOW_ID(i) \ - (* (Window *) & IMAGE_INSTANCE_SUBWINDOW_ID (i)) + (* (Window *) & IMAGE_INSTANCE_SUBCONTROL_ID (i)) #define IMAGE_INSTANCE_X_WIDGET_ID(i) \ - (* (Widget *) & IMAGE_INSTANCE_SUBWINDOW_ID (i)) + (* (Widget *) & IMAGE_INSTANCE_SUBCONTROL_ID (i)) #define XIMAGE_INSTANCE_X_SUBWINDOW_PARENT(i) \ IMAGE_INSTANCE_X_SUBWINDOW_PARENT (XIMAGE_INSTANCE (i)) ＠＠ -147,7 +147,7 ＠＠ #define DOMAIN_X_WIDGET(domain) \ ((IMAGE_INSTANCEP (domain) && \ - X_SUBWINDOW_INSTANCE_DATA (XIMAGE_INSTANCE (domain))) ? \ + X_SUBCONTROL_INSTANCE_DATA (XIMAGE_INSTANCE (domain))) ? \ XIMAGE_INSTANCE_X_WIDGET_ID (domain) : \ FRAME_X_CONTAINER_WIDGET (f) (DOMAIN_XFRAME (domain))) 1.51.4.1 +2412 -884 XEmacs/xemacs/src/glyphs.c Index: glyphs.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/glyphs.c,v retrieving revision 1.51 retrieving revision 1.51.4.1 diff -u -r1.51 -r1.51.4.1 --- glyphs.c 2005/02/03 16:14:06 1.51 +++ glyphs.c 2005/02/16 00:43:24 1.51.4.1 ＠＠ -1,7 +1,7 ＠＠ /* Generic glyph/image implementation + display tables Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. Copyright (C) 1995 Tinker Systems - Copyright (C) 1995, 1996, 2000, 2001, 2002, 2004 Ben Wing + Copyright (C) 1995, 1996, 2000, 2001, 2002, 2004, 2005 Ben Wing Copyright (C) 1995 Sun Microsystems Copyright (C) 1998, 1999, 2000 Andy Piper ＠＠ -27,6 +27,709 ＠＠ /* Written by Ben Wing and Chuck Thompson. Heavily modified / rewritten by Andy Piper. */ +/* Commentary: + + + Other docs from various places + + This contains one entry per format, per device it's defined on. There + will also be one entry per format with device == Qnil; these are the + non-device-specific methods. The idea is that there are a series of + methods (redisplay, get-property, etc.) that can be defined for each + format, in a device-independent fashion; but particular devices can + supply their own versions of the methods that in essence supersede the + non-device-specific methods. (The exact relation between a + device-specific method and the non-device-specific method depends on the + method -- for each method, a function is defined to call that method, + and it handles the specifics of calling the various methods. In + general, however, the device-specific methods are called before the + non-device-specific method. + + Actual function to create an image instance from an instantiator. If + OVERWRITE_ME is non-nil, it should be an image instance with the same + governing domain as GOVERNING_DOMAIN, and we will attempt to reuse it + instead of creating a new one. (Currently this only works if the + instantiator types are the same. This restriction is necessary because + otherwise the image instance type may change, and + update_image_instance() doesn't handle that (the hash tables, as + manipulated by image_instantiate() (called when instantiating the image + in a glyph, when it looks in its cache to avoid creating a new image + instance) also key off of the instantiator format, which guarantees that + the image instance type will not change; if we started changing the + instance types of image instances, we'd have to change the hashing + code). #### I'm not sure what would happen if we tried to handle + different instantiator types by just calling finalize_image_instance() + then initialize_image_instance(). Would redisplay pick it up correctly? + --ben) + + This is exactly like Fmake_image_instance() except that if OVERWRITE_ME + is non-nil, it attempts to overwrite an existing image instance. This + is used when instantiating widgets for efficiency (to avoid lots of + excessive flashing) and so as to preserve reasonable semantics involving + image instances (if you're a callback function holding on to an image + instance and you change the instantiator, your image instance should + still be valid, just with different properties). The governing domain + of the existing image instance must be the same as the new governing + domain as determined from DOMAIN, or we will abort. Currently we can + only overwrite an image instance with the same instantiator type (see + instantiate_image_instantiator()); otherwise, we get a new one. + + Image instance domain manipulators. We can't error check in these + otherwise we get into infinite recursion. + + Recurse up the hierarchy looking for the topmost glyph. This means + that instances in layouts will inherit face properties from their + parent. + + We don't currently expose this to Lisp because it's probably not a good + idea to do so. + + Update an image instance from its changed instantiator. This happens + either the first time we create an image instance, or when an + instantiator changes after we've already instantiated the glyph. Note + that image instances are per-glyph and per-governing-domain (window for + subcontrols, else device), as well as per-ii-format (^^#### document + why). We use hash tables (device->image_instance_cache or + frame->subcontrol_instance_cache) to keep track of the image instances + we've created, keyed by the above values, so that a change to the + instantiator will change an existing image instance rather than make a + new one. + + Layout the image instance using the provided dimensions. Layout + widgets are going to do different kinds of calculations to + determine what size to give things so we could make the layout + function relatively simple to take account of that. An alternative + approach is to consider separately the two cases, one where you + don't mind what size you have (normal widgets) and one where you + want to specify something (layout widgets). + + If the instantiator is identical then do nothing. We must use + equal here because the specifier code copies the instantiator. + + Extract the changed properties so that device / format + methods only have to cope with these. We assume that + normalization has already been done. + + ^^#### certainly we need to record deleted properties as well as + added ones. + + Instance and therefore glyph has changed so mark as dirty. + If we don't do this output optimizations will assume the + glyph is unchanged. + + We should now have a consistent instantiator so keep a record of + it. It is important that we don't actually update the window + system widgets here - we must do that when redisplay tells us + to. + + #### should we delay doing this until the display is up-to-date + also? + + Sort out the size of the text that is being displayed. Calculating + it dynamically allows us to change the text and still see + everything. Note that the following methods are for text not string + since that is what the instantiated type is. The first method is a + helper that is used elsewhere for calculating text geometry. + + Given a specification for an image, return an instance of + the image which matches the given instantiator and which can be + displayed in the given domain. + + make sure that the image instance's governing domain and type are + matching. + + #### This function should be able to cope with *all* + changes to the instantiator, but currently only copes + with the most used properties. This means that it is + possible to make changes that don't get reflected in the + display. + + ^^#### I'm sure this is wrong. We're turning off the dirty flag + on the glyph itself after processing a single window. We + definitely shouldn't be doing this until the end of redisplay! + +*/ + +/* ^^#### + +------------------------------- +| INTRO | +------------------------------- + +-- A glyph in XEmacs is an object encapsulating a graphical element, such as +an image or widget. + +-- A widget is an interactive window-system element such as a button or text +field; \"widget\" is the term for this under X Windows, and it's called a +\"control\" under MS Windows. + +-- Note that "glyph" does NOT refer to a single unit of textual display; in +XEmacs, the term for this is \"rune\". (The reason for this is historical; +glyphs originally appeared as objects to be attached to extents around +19.6.) + +-- The element that controls how a glyph appears is called an "image +specifier" -- see specifier.c. Specifiers are complex objects that let you +control the value of something (usually graphical or display-related) on a +buffer, window, frame, device or console level. The image specifier object +actually occupies the `image' property of the glyph; there are a few other +built-in properties of glyphs as well (also specifiers, but different, +simpler kinds -- integer or boolean specifiers), as well as user-specified +properties. See `make-glyph'. + +-- If you don't understand about specifiers, instantiators, and instances, +read the documentation for `make-glyph' and the general documentation on +specifiers, especially in the Lisp Reference manual. The format for image +instantiators is a vector or (#### to be implemented) an instantiator +object. For vectors, the first element is a symbol, the "instantiator +format", and the rest are key-value pairs, specifying properties. The +image instantiator format specifies the format of the incoming data (`gif', +`jpeg', `string', etc. as well as `button', `edit-field', etc.). + +-- The resulting instances of an image specifier are image-instance +objects. The type of an image instance determines the appearance on the +glyph. The different types are such as `mono-pixmap', `color-pixmap', +`pointer', `subwindow', `widget', etc. It is important to keep the +distinction between image instantiator format and image instance type in +mind. Typically, a given image instantiator format can result in many +different image instance types (for example, `xpm' can be instanced as +`color-pixmap', `mono-pixmap', or `pointer'; whereas `cursor-font' can be +instanced only as `pointer'), and a particular image instance type can be +generated by many different image instantiator formats (e.g. +`color-pixmap' can be generated by `xpm', `gif', `jpeg', etc.). The +different possible image instantiator formats and image instance types, and +their correspondences, are described in detail in the docs for `make-glyph' +and `make-image-instance'. + +-- A bit more terminology: a "subwindow" is an embedded windowing system +window whose contents are under the control of an external program. +Widgets also involve a child window-system window, and the term +"subcontrol" collectively refers to either subwindows or widgets. + +Glyphs are extremely complicated, as you might imagine from the above +discussion. The most basic reason for this is the quite varied purposes +they can be put to -- there are numerous possible instantiator formats +\(`nothing', `string', `formatted-string', `xpm', `xbm', `xface', `gif', +`jpeg', `png', `tiff', `cursor-font', `font', `autodetect', `subwindow', +`inherit', `mswindows-resource', `bmp', `native-layout', `layout', `label', +`tab-control', `tree-view', `progress-gauge', `scrollbar', `combo-box', +`edit-field', `button', `widget', `pointer', and `text' -- #### the last +three are bogus pseudo-formats -- see below), numerous possible instance +types \(`nothing', `text', `mono-pixmap', `color-pixmap', `pointer', +`subwindow', and `widget'), different possible glyph types (`buffer', +`icon', `pointer' -- see `make-glyph-internal'), and numerous different +places where a glyph may be used (begin-glyph or end-glyph of an extent in +a buffer [resulting in a glyph in buffer text or the left or right margins] +or in a string used to control the gutter; modeline element; toolbar; frame +icon; pointer; miscellaneous built-in redisplay effects [truncation, +continuation, horizontal-scroll indicators; the dots marking invisible +text; the ^ marking a control character in a buffer; the \ marking an octal +escape character in a buffer; see `continuation-glyph' for a discussion of +all of these]; the overlay arrow hack [`overlay-arrow-string']; display +tables; the appearance of a button [its :image property]; and background +pixmaps \[used for text, in place of a solid-color background and *NOT* +actually a glyph -- see next paragraph]). See `make-glyph'. + +Note finally that image specifiers are used not only as the `image' +property of a glyph but the `background-pixmap' property of a face, and can +also be created on their own by the user. + +#### Note also that there are three bogus instantiator formats, currently +necessary due to some internal confusion between instantiator formats and +instance types. Internally we handle the different formats using +format-specific methods; we also ought to have instance-type-specific +methods, but we don't, so Andy created pseudo-formats for some instance +types and wrote code that passes instance types to functions that expect +instantiator formats. This should really be cleaned up. (Things are +further confused by widgets, where widget-instance methods vary depending +on the widget-instance type -- which is generally identical with the +instantiator format. What we really need, then, are "pseudo-instance-type +methods", which depend on the instance type but, for widgets, are further +subcharacterized by the widget type.) + +-------------------------------------- +| GOVERNING DOMAINS | +-------------------------------------- + +The "governing domain" of an image instance is (more or less) the domain +\(device, window, or frame) to which the window-system data in the image +instance is attached. For example, a window-system pixmap object can be +displayed anywhere within a particular device, but (in X) not on other +displays or screens. A text image instance, with no attached window-system +object, should have a "global" domain or whatever, but to simplify things, +we should give them a device domain. (#### In fact, however, we give them a +window domain! I think this was a misguided attempt to "account" for the +fact that a text image instance may have a different size in a different +window, since it depends on faces, which can be window-specific. However, +the window is passed in as the "domain" parameter to query-geometry, so +this shouldn't be necessary. #### I think I understand what's going on +here -- Andy started passing image instances as the "domain" parameter, +which obscures the actual window unless it's in the image instance. +Obvious solution is to not do this, and abort when we get an image instance +as domain to flush the stuff out.) + +Widgets properly should have a "frame" governing domain, since they are +child windows of a particular frame, and can moved around (e.g. from one +XEmacs window to another), but not (normally!) moved to another frame +\(i.e. window-system window). However, widgets have additional weirdness +in that they can appear only once -- you could attach the same pixmap to +many glyphs displayed in a frame, but for widgets, each glyph needs a +*separate* image instance, encapsulating a *separate* widget, for each +widget that's displayed in a frame. To deal with this, Andy originally +implemented the hack of making the governing domain a window, so that it +was at least possible to display the same glyph in two different windows -- +he had the gutters in mind, in particular (or another common possibility -- +a subcontrol is displayed in a window and the window is split). This works +as long as any particular subcontrol glyph is displayed only once in a +buffer; otherwise you get infinite flashing as redisplay attempts to put +the same subwindow in two different places. + +What I've done to partially remedy this is to further characterize +subcontrol instances by the object that the glyph is attached to (e.g. its +extent) as well as the window. This solves the problem of having the same +subcontrol glyph attached to two different extents in the same window. To +do this, I use the MATCHSPEC parameter to `specifier-instance' to pass in +the governing object. MATCHSPEC will generally be an extent (glyph +attached to extent), image instance (glyph attached to button widget +through :image), toolbar button (glyph in a toolbar), cons (glyph in +`modeline-format') or nil (can't determine anything that glyph is attached +to -- e.g. built-in glyphs such as truncator-glyph.) When instantiating a +subcontrol image specifier, we record both the MATCHSPEC and governing +domain (the window) in the hash table cache key, so that we're keying off +of MATCHSPEC, and get different instances for different matchspecs. This +works reasonably efficiently as long as the user doesn't constantly change +extent/toolbar/etc properties. The glyph instantiation code, when given an +extent, looks further to see if the glyph is attached to the extent's +begin-glyph or end-glyph property and records this in its cache, to account +for the possibility of the same glyph attached to both begin-glyph and +end-glyph of an extent. + +#### Unfortunately this still fails for subcontrol glyphs set as the +truncation/continuation glyph, in a display table, etc. We could try to +make the "governing object" in such a case be the line number and rune +number; but this will be extremely inefficient since those numbers will +change frequently, as the user scrolls, and thus we will have tons of +instances in our cache. + +Another approach would be to not key off of anything at all but instead, +for each glyph, the hash table value is actually a list of image instances; +when we want one, we check to see if the ones that are there are displayed, +and if so, get a new one. However, that also gets tricky because you want +identity of image instances across multiple calls to +glyph_image_instance(), which is handled correctly by the matchspec +approach. Maybe we'd need some sort of combination: + +For each glyph and frame, we keep a list of image instances created. Each +of them has a mapped/unmapped flag, reflecting what's actually going on, +plus a "busy" flag that redisplay can set when it gets an instance it's +\(maybe) going to display. That means it needs to reset that flag on all +the instances it looked at when it's done. In addition, it passes in a key +of some sort, basically the MATCHSPEC above, which is written into the +image instance; and so a comparison is done first to see if such an object +exists. If not, then we look for an unmapped, non-busy image instance or +create one, and set its MATCHSPEC appropriately. The caller then sets the +busy flag. + +Ugh, this is a LOT more complicated than the approach I'm taking. I'll +probably not implement it, since it doesn't seem worth it. Instead, I'm +just disallowing subcontrol glyphs in the display tables and built-in glyphs. + +---------------- + +`make-image-instance' has the following to say about domains vs. governing +domains: + +DOMAIN specifies the domain to which the image instance will be attached. +This domain is termed the \"governing domain\". The type of the governing +domain depends on the image instantiator format. (Although, more correctly, +it should probably depend on the image instance type.) For example, pixmap +image instances are specific to a device, but widget image instances are +specific to a particular XEmacs window because in order to display such a +widget when two windows onto the same buffer want to display the widget, +two separate underlying widgets must be created. (That's because a widget +is actually a child window-system window, and all window-system windows have +a unique existence on the screen.) This means that the governing domain for +a pixmap image instance will be some device (most likely, the only existing +device), whereas the governing domain for a widget image instance will be +some XEmacs window. + +If you specify an overly general DOMAIN (e.g. a frame when a window was +wanted), an error is signaled. If you specify an overly specific DOMAIN +\(e.g. a window when a device was wanted), the corresponding general domain +is fetched and used instead. For `make-image-instance', it makes no +difference whether you specify an overly specific domain or the properly +general domain derived from it. However, it does matter when creating an +image instance by instantiating a specifier or glyph (e.g. with +`glyph-image-instance'), because the more specific domain causes spec lookup +to start there and proceed to more general domains. (It would also matter +when creating an image instance with an instantiator format of `inherit', +but we currently disallow this. #### We should fix this.) + +If omitted, DOMAIN defaults to the selected window. + +-------------------------------------- +| THE IMAGE INSTANCE CACHES | +-------------------------------------- + +#### This is not up to date. + +First note that there are two such caches: one in frames and one in devices: + +-- in devices: MARKED_SLOT (image_instance_cache); +-- in frames: MARKED_SLOT (subcontrol_instance_cache); + +The device cache holds instances whose governing domain is a device; the +frame cache holds instances whose governing domain is a window (subcontrols +and, bogusly, text image instances -- see comment under governing domains). + + The frame cache (i.e. subcontrol cache) caches subcontrols (subwindows + and widgets) (#### and also currently text image instances, which I + think is bogus) -- i.e. whenever the governing domain is a window rather + than a device. The hash key is a list of three elements: an object + describing where the image instance came from (a specifier or image + instance), a window (the governing domain), and the instantiator format + (a symbol). The value is either an image instance or an instantiator. + More specifically, the entries encompass the following cases: + + 1) When an image instance is created as a result of instantiating an + image specifier (typically either the image property of a glyph or + the background-pixmap property of a face), the key will be + a list of the glyph or face (or the specifier itself if it was + user-created), the governing domain, and the instantiator + format, and the value will be the image instance. + 2) When we attempt to instantiate but fail, the key will be the same + but the value is the instantiator. This allows us to check next + time through and see whether the instantiator has changed. + 3) When an image instance is created by itself (either by a direct + call to make-image-instance or from the layout code, when it + creates child image instances), the key will be a list of the + image instance itself, the governing domain, and the instantiator + format, and the value will be the image instance. + + The first element of the key list is used (a) to make sure that we have + distinct keys for distinct specifiers, but keep the same image instance + for the same specifier even when the instantiator changes (preserving + instance identity like this is important both for the user code, + e.g. callbacks, and to stop excessive window system widget creation and + deletion -- and hence flashing); and (b) to determine whether to keep + this entry. + + We keep the entries in the cache if both the window (second element) and + either the first element of the hash key or the value are referenced. + We use the first element (the specifier, usually) so that the cache + actually caches things, as there may be no reference to the instance + anywhere. + +They serve at least two basic purposes: + +1. to speed up instantiation, by looking up to see if we've instantiated + this item before, and using the cached one if so. This works + differently with pixmaps and subcontrols -- pixmaps are essentially + constant items, so if the pixmap instantiator changes, we get a new + image instance. Subcontrols, however, are dynamic, and we want the same + image instance to remain around even when some of its properties are + changed. Thus, the key in the hash table will include the instantiator + for pixmaps, but it will not be included for subwindows, which include + the glyph instead. + +2. as a list of all the widgets that currently exist in a window or + frame. (In fact, the frame subcontrol instance cache serves only as a + list.) + +#2 means that all widgets that are created need to be registered in the +tables even if they're not created through image_instantiate(), which does +the hashing. This in particular applies to make_image_instance_1, which is +the other way (other than image_instantiate()) of creating image instances. +\(image_instantiate() happens as a result of instantiating the glyph's +image specifier; make_image_instance_1() happens either by the user +directly calling make-image-instance or the internal layout code calling +overwrite_image_instance(), when it creates trees of image instances, which +\(except for the topmost) are not directly connected to a glyph (i.e. their +parent is not a glyph). + +#### Document exactly what uses the tables for these two purposes. + + +^^#### implement this; may also need to implement an internal +"general-weak" type where a function is passed in to do the marking and +indicate what's weak. + + Subcontrols are curious in that you have to physically unmap them to + not display them. It is problematic deciding what to do in + redisplay. We have two caches - a per-window instance cache that + keeps track of subcontrols on a window, these are linked to their + instantiator in the hashtable and when the instantiator goes away + we want the instance to go away also. However we also have a + per-frame instance cache that we use to determine if a subcontrol is + obscuring an area that we want to clear. We need to be able to flip + through this quickly so a hashtable is not suitable hence the + subcontrol_cachels. This is a weak list so unreference instances + will get deleted properly. + + redisplay in general assumes that drawing something will erase + what was there before. unfortunately this does not apply to + subcontrols that need to be specifically unmapped in order to + disappear. we take a brute force approach - on the basis that its + cheap - and unmap all subcontrols in a display line + + Put new instances in the frame subcontrol cache. This is less costly than + doing it every time something gets mapped, and deleted instances will be + removed automatically. + + Unmap and finalize all subcontrol instances in the frame cache. This + is necessary because GC will not guarantee the order things get + deleted in and moreover, frame finalization deletes the window + system windows before deleting XEmacs windows, and hence + subcontrols +int + + #### How ugly !! An image instantiator that uses a kludgy syntax to + #### snarf in face properties. There's a design flaw here. -- + #### didier + + We have to put subwindow, widget and text image instances in + a per-window cache so that we can see the same glyph in + different windows. We use governing_domain to determine the type + of image_instance that will be created. + + We cannot simply key on the glyph since fallbacks could use + the same glyph but have a totally different instantiator + type. Thus we key on the glyph and the type (but not any + other parts) of the instantiator. + + Make sure we cache the failures, too. Use an + unwind-protect to catch such errors. If we fail, the + unwind-protect records nil in the hash table. If we + succeed, we change the car of the locative to the + resulting instance, which gets recorded instead. + + We found an instance. However, because we are using the glyph + as the hash key instead of the instantiator, the current + instantiator may not be the same as the original. Thus we + must update the instance based on the new + instantiator. Preserving instance identity like this is + important to stop excessive window system widget creation and + deletion - and hence flashing. + +------------------------------- +| THE DIRTY FLAGS | +------------------------------- + + ^^#### need to review the usage of the image-instance-dirty flags and + make sure the general dirty flag gets turned on/off as necessary. + +-- There are per-device and per-frame glyphs_changed flags that tell +redisplay whether to bother investigating any glyph/image-instance changes. +These are used in the top-level check to see if anything at all has +changed; if not, redisplay may skip out entirely. #### used anywhere else? + +-- There's also a per-glyph dirty flag, which gets set below as a result of +set_image_instance_dirty_p() (it recurses up the image instance hierarchy; +the topmost image instance will have a glyph parent). It also gets set +#### where else? The dirty flags on all glyphs get reset by +mark_glyph_cachels_as_clean(), which is called at the end of +redisplay_window(), and resets the dirty flag on all glyphs that are cached +in the window's cachel data (#### does this always include all glyphs? +what about if a glyph has instances in more than one window? resetting the +dirty flag seems wrong after just one window), and also resets the dirty +flag on all of those glyphs' image instances in that window (#### what if +the image instances are visible in more than one window, e.g. when the +governing domain is a device? is it inefficient to do all this specifier +instantiation at the end of each redisplay?). The per-glyph dirty flag is +looked at in compare_runes(), which sets some optimization flag (#### how +does this work), and #### where else is the per-glyph dirty flag +referenced? what's its purpose? + +-- There's also a per-image-instance dirty flag, which is set by +set_image_instance_dirty_p() and reset above in +mark_glyph_cachels_as_clean(), and #### where else? This flag sometimes +controls whether we attempt to redisplay the image instance (#### but not +always, although it should). for widgets, when the display block (#### +that's a line, i think?) containing the widget is outputted by the +device-specific code, redisplay_output_layout() is called to redisplay the +layout. (#### what triggers whether the display block is outputted? +there's also too much stuff in the device-specific code here.) + +-- when redisplay_output_layout() is called, it looks at the image-instance +dirty flag for some of its children, to determine whether to do anything, +but for itself it bogusly looks instead at all the more specific "changed" +flags, as well as an "optimization" flag set by compare_runes() #### which +i don't understand the purpose of. #### we should always use the +image-instance-dirty flag to indicate whether anything needs to be done. + +-- the image instance has various "changed" flags indicating more +specifically what needs to be done. + -- #### document when these are set and reset. + -- #### document what these trigger. + +-- #### document all the circumstances in which a widget might need to be +changed. these include a change to its glyph's instantiator (#### document +how that all works), a change to the image instance's properties (#### not +currently implemented; i need to figure out all this stuff first), +`focus-image-instance' called (#### not implemented), a widget being +activated (#### what's exactly going on here?), #### anything else? + +#### make a diagram of all the changed/dirty flags and their relationships. + + + ------------------------------ +| THE GLYPH CACHELS | +------------------------------- + +Glyph cachels seem to have two purposes: (a) to cache width/height info +about glyph instances in a particular window (only used currently for the +built-in glyphs, e.g. truncation/continuation glyph), and (b) to record +all the glyphs processed by redisplay so that we can eventually (at the +end of redisplay) reset their dirty flags. + +Built-in glyphs are always located at particular indices in the cachel +array. Currently this is the only way to access the cachel for a +particular glyph; that means the width/height info is only currently used +for the built-in glyphs. + +^^#### Unfortunately, the dirty-flag code doesn't work at all currently, +because we're resetting the dirty flags at the end of each window +\(mark_glyph_cachels_as_clean(), called from redisplay_window()) instead of +at the end of redisplay entirely. We're also periodically cleaning out the +cache in the middle of redisplay_window(), which is totally wrong, since +we'll forget what we've recorded. (A legacy from the face cache. The dirty +flags on faces are reset by iterating through all faces, recorded in a +global list, which we don't [currently] have for glyphs.) + +----------------------------------------------------- +| WHAT ACTIONS TRIGGER CHANGES, AND WHAT RESULTS | +----------------------------------------------------- + +-- generally, it seems, there are two kinds of changes -- changes to a +specific image instance, and changes to a glyph, which can potentially +trigger changes in any of the glyph's image instances on any +devices/frames/windows. + + 1. when a widget is changed, what ought to happen is that the proper + "changed" flag is set, which triggers the general image-instance-dirty + flag, which cascades up the hierarchy and sets all the ancestors' dirty + flags and eventually the dirty flag of the containing glyph (#### is + this really necessary?), and then the glyphs-changed flag of the frame, + which tells redisplay to wake up. #### unfortunately, it appears that + these connections don't always work, because after a callback is + executed, the code manually runs update_widget_instances(), which does a + brute-force scan of all the widgets in the frame's "subcontrol cache", + checks their changed flags, and sets the image-instance/glyph dirty + flags and the glyphs-changed flag of the frame. (#### does the + subcontrol cache always include all widgets in the frame?) + + 2. when a glyph's instantiator properties are changed, + -- #### somehow or other redisplay needs to know to go see what + changed. that's what the global and per-device/frame glyphs-changed + flags are for, but they're not currently being set except for the few + built-in glyphs, e.g. `octal-escape-glyph' or `hscroll-glyph'; it + appears that this ends up happening either by luck (something else + triggers everything) or by the bogus update_widget_instances() below. + + -- once redisplay decides to check everything out, it generates a new + window structure (which includes only the "runes", i.e. one glyph is + a single rune, and nothing below is changed), and then compares the + structures, which will end up calling compare_runes() to compare + individual runes. (in the process of doing this, the glyph will get + instantiated in the window domain, which will trigger the update routines + below.) when it compares glyphs, #### some stuff happens, + and we end up returning whether the glyph has changed. #### there's + also an optimize flag being set here, need to document. for each + line, we then call redisplay_output_display_block() on the portion of + the line that's changed. #### we don't handle at all the case where + a glyph just moves, it appears. perhaps that's handled in the code + that redisplays the glyph? + + -- redisplay_output_display_block(), when it gets to a glyph, it will + call either redisplay_output_pixmap() for a mono or color pixmap, + redisplay_output_layout() for a layout widget, or + redisplay_output_subcontrol() for other types of subcontrols + (i.e. for subwindows and non-layout widgets). + + 3. update_widget_instances() -- it appears that this function isn't + quite as bogus as I thought. When you have radio buttons, for example, + the `selected' field can be a Lisp expression -- often one button is set + to an expression like `radio-button-selected' and the other `(not + radio-button-selected)' where radio-button-selected is a global var. + Unfortunately then, the problem is how to notice when + radio-button-selected has changed. Andy took the brute force heuristic + approach of iterating over all the instances once the user activated a + button, on the assumption that this is the most likely time that such a + value might change. #### I still don't understand exactly what + update_widget_instances() does; I can't find the place where it ends up + checking and evaluating `selected', but maybe i have to look farther. + + #### I think the real solution here is not to use eval-able fields for + `selected', which is inherently un-optimizable. Instead, the callback + for the radio button being selected simply goes and unselects the + others. This can happen by changing the instantiator. Once I implement + instantiator objects, making the change is extremely easy -- you just + set a property on the instantiator object; no need to muck around with + vectors. + +-------------------------------------------------------- +| CALL TREE OF FUNCTIONS UPDATING THE DIRTY FLAGS | +-------------------------------------------------------- + +set_glyph_dirty_p <-- mark_glyph_cachels_as_clean +set_image_instance_dirty_p <-- + update_image_instance <-- + instantiate_image_instantiator <-- + make_image_instance_1 <-- `make-image-instance' <-- + [called from Lisp] + smash_face_fallbacks() in gtk-xemacs.c, related to background pixmaps + overwrite_image_instance <-- + layout_update <-- + update_image_instance + image_instantiate + [called when a glyph is instantiated; it will call go through + this path, i.e. call instantiate_image_instantiator(), when not + found in the hash table; see below] + image_instantiate + [called when glyph is instantiated; in order to make things work + quickly and with the right semantics -- i.e. image instance objects + are kept around when a property changes -- we use a hash table to + track created image instances, indexed by the glyph, its governing + domain [a window for subcontrols (#### and text image instances?), + a device for others]. .... ####], and its type (#### why exactly is + the type included again?). when an instantiator is changed in a glyph, + the existing image instance (which is per-glyph) is modified using + update_image_instance(). note that in either case -- of an image + instance created anew or updated -- we end up going through + update_image_instance().] + update_widget_instances <-- + [ #### should not exist; a sign that dirty flags are not correctly getting + set. ] + mswindows_handle_gui_wm_command + [ user clicks on a button, etc ] + popup_selection_callback + [ user clicks on a button, etc ] + glyph-animated-timeout-handler + [ timeout goes off, to update an animated glyph ] + + +MARK_FRAME_GLYPHS_CHANGED <-- + set-device-class + update_widget_instances <-- + #### + redisplay_glyph_changed + [an instantiator was changed in a built-in glyph, e.g. `octal-escape-glyph' + or `hscroll-glyph'; this is triggered from specifier.c by + image_after_change(), which looks at the `attachee' field to find + its glyph and calls glyph_property_was_changed() on it; this in turn + checks the glyph's `after_changed' field, which points to + redisplay_glyph_changed() for built-in glyphs and nothing for others. + (#### then how do glyph changes in general get signalled?) + ] + +MARK_GLYPHS_CHANGED <-- + initialize_image_instance + +MARK_DEVICE_FRAMES_GLYPHS_CHANGED <-- + glyph-animated-timeout-handler + +*/ + #include <config.h> #include "lisp.h" ＠＠ -35,6 +738,7 ＠＠ #include "chartab.h" #include "device-impl.h" #include "elhash.h" +#include "extents-impl.h" #include "faces.h" #include "frame-impl.h" #include "glyphs.h" ＠＠ -45,6 +749,7 ＠＠ #include "rangetab.h" #include "redisplay.h" #include "specifier.h" +#include "toolbar.h" #include "window.h" #include "sysfile.h" ＠＠ -62,6 +767,7 ＠＠ Lisp_Object Qcolor_pixmap_image_instance_p; Lisp_Object Qpointer_image_instance_p; Lisp_Object Qsubwindow_image_instance_p; +Lisp_Object Qsubcontrol_image_instance_p; Lisp_Object Qwidget_image_instance_p; Lisp_Object Qconst_glyph_variable; Lisp_Object Qmono_pixmap, Qcolor_pixmap, Qsubwindow; ＠＠ -123,11 +829,27 ＠＠ { Dynarr_declare (struct image_instantiator_format_entry); } image_instantiator_format_entry_dynarr; + +/* This contains one entry per format, per device it's defined on. There + will also be one entry per format with device == Qnil; these are the + non-device-specific methods. The idea is that there are a series of + methods (redisplay, get-property, etc.) that can be defined for each + format, in a device-independent fashion; but particular devices can + supply their own versions of the methods that in essence supersede the + non-device-specific methods. (The exact relation between a + device-specific method and the non-device-specific method depends on the + method -- for each method, a function is defined to call that method, + and it handles the specifics of calling the various methods. In + general, however, the device-specific methods are called before the + non-device-specific method. */ -/* This contains one entry per format, per device it's defined on. */ image_instantiator_format_entry_dynarr * the_image_instantiator_format_entry_dynarr; +static Lisp_Object initialize_image_instance (Lisp_Object image_instance, + Lisp_Object governing_domain, + Lisp_Object parent, + Lisp_Object instantiator); static Lisp_Object allocate_image_instance (Lisp_Object governing_domain, Lisp_Object parent, Lisp_Object instantiator); ＠＠ -136,10 +858,10 ＠＠ Lisp_Object property, Lisp_Object locale); static void set_image_instance_dirty_p (Lisp_Object instance, int dirty); -static void register_ignored_expose (struct frame* f, int x, int y, int width, int height); -static void cache_subwindow_instance_in_frame_maybe (Lisp_Object instance); +static void register_ignored_expose (struct frame *f, int x, int y, int width, int height); static void update_image_instance (Lisp_Object image_instance, - Lisp_Object instantiator); + Lisp_Object instantiator, + Lisp_Object domain); /* Unfortunately windows and X are different. In windows BeginPaint() will prevent WM_PAINT messages being generated so it is unnecessary to register exposures as they will not occur. Under X they will ＠＠ -202,7 +924,7 ＠＠ valid_image_instantiator_format_p (Lisp_Object format, Lisp_Object locale) { int i; - struct image_instantiator_methods* meths = + struct image_instantiator_methods *meths = decode_image_instantiator_format (format, ERROR_ME_NOT); Lisp_Object contype = Qnil; /* mess with the locale */ ＠＠ -210,7 +932,7 ＠＠ contype = locale; else { - struct console* console = decode_console (locale); + struct console *console = decode_console (locale); contype = console ? CONSOLE_TYPE (console) : locale; } /* nothing is valid in all locales */ ＠＠ -232,12 +954,12 ＠＠ If LOCALE is non-nil then the format is checked in that locale. If LOCALE is nil the current console is used. -Valid formats are some subset of 'nothing, 'string, 'formatted-string, -'xpm, 'xbm, 'xface, 'gif, 'jpeg, 'png, 'tiff, 'cursor-font, 'font, -'autodetect, 'subwindow, 'inherit, 'mswindows-resource, 'bmp, -'native-layout, 'layout, 'label, 'tab-control, 'tree-view, -'progress-gauge, 'scrollbar, 'combo-box, 'edit-field, 'button, -'widget, 'pointer, and 'text, depending on how XEmacs was compiled. +Valid formats are some subset of `nothing', `string', `formatted-string', +`xpm', `xbm', `xface', `gif', `jpeg', `png', `tiff', `cursor-font', `font', +`autodetect', `subwindow', `inherit', `mswindows-resource', `bmp', +`native-layout', `layout', `label', `tab-control', `tree-view', +`progress-gauge', `scrollbar', `combo-box', `edit-field', `button', +`widget', `pointer', and `text', depending on how XEmacs was compiled. */ (image_instantiator_format, locale)) { ＠＠ -249,6 +971,15 ＠＠ DEFUN ("image-instantiator-format-list", Fimage_instantiator_format_list, 0, 0, 0, /* Return a list of valid image-instantiator formats. + +Valid formats are some subset of `nothing', `string', `formatted-string', +`xpm', `xbm', `xface', `gif', `jpeg', `png', `tiff', `cursor-font', `font', +`autodetect', `subwindow', `inherit', `mswindows-resource', `bmp', +`native-layout', `layout', `label', `tab-control', `tree-view', +`progress-gauge', `scrollbar', `combo-box', `edit-field', `button', +`widget', `pointer', and `text', depending on how XEmacs was compiled. + +See `make-glyph' for a discussion of what they mean. */ ()) { ＠＠ -436,6 +1167,10 ＠＠ return find_keyword_in_vector_or_given (vector, keyword, Qnil); } + +/* ^^#### certainly we need to record deleted properties as well as added + ones. */ + static Lisp_Object find_instantiator_differences (Lisp_Object new, Lisp_Object old) { ＠＠ -471,50 +1206,6 ＠＠ } } -DEFUN ("set-instantiator-property", Fset_instantiator_property, - 3, 3, 0, /* -Destructively set the property KEYWORD of INSTANTIATOR to VALUE. -If the property is not set then it is added to a copy of the -instantiator and the new instantiator returned. -Use `set-glyph-image' on glyphs to register instantiator changes. */ - (instantiator, keyword, value)) -{ - Lisp_Object *elt; - int len; - - CHECK_VECTOR (instantiator); - if (!KEYWORDP (keyword)) - invalid_argument ("instantiator property must be a keyword", keyword); - - elt = XVECTOR_DATA (instantiator); - len = XVECTOR_LENGTH (instantiator); - - for (len -= 2; len >= 1; len -= 2) - { - if (EQ (elt[len], keyword)) - { - elt[len+1] = value; - break; - } - } - - /* Didn't find it so add it. */ - if (len < 1) - { - Lisp_Object alist = Qnil, result; - struct gcpro gcpro1; - - GCPRO1 (alist); - alist = tagged_vector_to_alist (instantiator); - alist = Fcons (Fcons (keyword, value), alist); - result = alist_to_tagged_vector (elt[0], alist); - free_alist (alist); - RETURN_UNGCPRO (result); - } - - return instantiator; -} - void check_valid_string (Lisp_Object data) { ＠＠ -634,34 +1325,6 ＠＠ } #ifdef ERROR_CHECK_GLYPHS -static int -check_instance_cache_mapper (Lisp_Object UNUSED (key), Lisp_Object value, - void *flag_closure) -{ - /* This function can GC */ - /* value can be nil; we cache failures as well as successes */ - if (!NILP (value)) - { - Lisp_Object window; - window = VOID_TO_LISP (flag_closure); - assert (EQ (XIMAGE_INSTANCE_DOMAIN (value), window)); - } - - return 0; -} - -void -check_window_subwindow_cache (struct window* w) -{ - Lisp_Object window = wrap_window (w); - - - assert (!NILP (w->subwindow_instance_cache)); - elisp_maphash (check_instance_cache_mapper, - w->subwindow_instance_cache, - LISP_TO_VOID (window)); -} - void check_image_instance_structure (Lisp_Object instance) { ＠＠ -669,12 +1332,9 ＠＠ deleted. */ if (!NOTHING_IMAGE_INSTANCEP (instance)) { - assert (DOMAIN_LIVE_P (instance)); + assert (image_instance_live_p (instance)); assert (VECTORP (XIMAGE_INSTANCE_INSTANTIATOR (instance))); } - if (WINDOWP (XIMAGE_INSTANCE_DOMAIN (instance))) - check_window_subwindow_cache - (XWINDOW (XIMAGE_INSTANCE_DOMAIN (instance))); } #endif ＠＠ -750,21 +1410,36 ＠＠ } } +/* Actual function to create an image instance from an instantiator. If + OVERWRITE_ME is non-nil, it should be an image instance with the same + governing domain as GOVERNING_DOMAIN, and we will attempt to reuse it + instead of creating a new one. (Currently this only works if the + instantiator types are the same. This restriction is necessary because + otherwise the image instance type may change, and + update_image_instance() doesn't handle that (the hash tables, as + manipulated by image_instantiate() (called when instantiating the image + in a glyph, when it looks in its cache to avoid creating a new image + instance) also key off of the instantiator format, which guarantees that + the image instance type will not change; if we started changing the + instance types of image instances, we'd have to change the hashing + code). #### I'm not sure what would happen if we tried to handle + different instantiator types by just calling finalize_image_instance() + then initialize_image_instance(). Would redisplay pick it up correctly? + --ben) */ + static Lisp_Object instantiate_image_instantiator (Lisp_Object governing_domain, Lisp_Object domain, Lisp_Object instantiator, Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object glyph) + int dest_mask, Lisp_Object parent, + Lisp_Object overwrite_me) { - Lisp_Object ii = allocate_image_instance (governing_domain, - IMAGE_INSTANCEP (domain) ? - domain : glyph, instantiator); - Lisp_Image_Instance* p = XIMAGE_INSTANCE (ii); + Lisp_Object ii; + Lisp_Image_Instance *p; struct image_instantiator_methods *meths, *device_meths; struct gcpro gcpro1; - GCPRO1 (ii); if (!valid_image_instantiator_format_p (INSTANTIATOR_TYPE (instantiator), DOMAIN_DEVICE (governing_domain))) invalid_argument ＠＠ -773,6 +1448,32 ＠＠ meths = decode_image_instantiator_format (INSTANTIATOR_TYPE (instantiator), ERROR_ME); + + if (!NILP (overwrite_me)) + assert (EQ (governing_domain, XIMAGE_INSTANCE_DOMAIN (overwrite_me))); + + if (!NILP (overwrite_me) && + EQ (INSTANTIATOR_TYPE (instantiator), + INSTANTIATOR_TYPE (XIMAGE_INSTANCE_INSTANTIATOR (overwrite_me)))) + { + update_image_instance (overwrite_me, instantiator, domain); + return overwrite_me; + } +#if 0 + /* #### here would be the code as described above */ + else if (!NILP (overwrite_me)) + { + finalize_image_instance (XIMAGE_INSTANCE (overwrite_me), 0); + initialize_image_instance (overwrite_me, governing_domain, + parent, instantiator); + ii = XIMAGE_INSTANCE (overwrite_me); + } +#endif + else + ii = allocate_image_instance (governing_domain, parent, instantiator); + + p = XIMAGE_INSTANCE (ii); + GCPRO1 (ii); MAYBE_IIFORMAT_METH (meths, instantiate, (ii, instantiator, pointer_fg, pointer_bg, dest_mask, domain)); ＠＠ -795,11 +1496,13 ＠＠ IMAGE_UNCHANGED_GEOMETRY, IMAGE_UNCHANGED_GEOMETRY, domain); - MAYBE_IIFORMAT_METH (device_meths, instantiate, (ii, instantiator, pointer_fg, - pointer_bg, dest_mask, domain)); + MAYBE_IIFORMAT_METH (device_meths, instantiate, + (ii, instantiator, pointer_fg, + pointer_bg, dest_mask, domain)); /* Do post instantiation. */ MAYBE_IIFORMAT_METH (meths, post_instantiate, (ii, instantiator, domain)); - MAYBE_IIFORMAT_METH (device_meths, post_instantiate, (ii, instantiator, domain)); + MAYBE_IIFORMAT_METH (device_meths, post_instantiate, + (ii, instantiator, domain)); /* We're done. */ IMAGE_INSTANCE_INITIALIZED (p) = 1; ＠＠ -816,8 +1519,7 ＠＠ IMAGE_INSTANCE_LAYOUT_CHANGED (p) = 0; IMAGE_INSTANCE_DIRTYP (p) = 0; - assert ( XIMAGE_INSTANCE_HEIGHT (ii) >= 0 - && XIMAGE_INSTANCE_WIDTH (ii) >= 0 ); + assert (XIMAGE_INSTANCE_HEIGHT (ii) >= 0 && XIMAGE_INSTANCE_WIDTH (ii) >= 0); ERROR_CHECK_IMAGE_INSTANCE (ii); ＠＠ -858,20 +1560,20 ＠＠ sizeof (struct pixmap_image_instance), pixmap_image_instance_description_1 }; -static const struct memory_description subwindow_image_instance_description_1 [] = { - { XD_LISP_OBJECT, offsetof (struct subwindow_image_instance, face) }, - { XD_LISP_OBJECT, offsetof (struct subwindow_image_instance, type) }, - { XD_LISP_OBJECT, offsetof (struct subwindow_image_instance, props) }, - { XD_LISP_OBJECT, offsetof (struct subwindow_image_instance, items) }, - { XD_LISP_OBJECT, offsetof (struct subwindow_image_instance, pending_items) }, - { XD_LISP_OBJECT, offsetof (struct subwindow_image_instance, children) }, - { XD_LISP_OBJECT, offsetof (struct subwindow_image_instance, width) }, - { XD_LISP_OBJECT, offsetof (struct subwindow_image_instance, height) }, +static const struct memory_description subcontrol_image_instance_description_1 [] = { + { XD_LISP_OBJECT, offsetof (struct subcontrol_image_instance, face) }, + { XD_LISP_OBJECT, offsetof (struct subcontrol_image_instance, type) }, + { XD_LISP_OBJECT, offsetof (struct subcontrol_image_instance, props) }, + { XD_LISP_OBJECT, offsetof (struct subcontrol_image_instance, items) }, + { XD_LISP_OBJECT, offsetof (struct subcontrol_image_instance, pending_items) }, + { XD_LISP_OBJECT, offsetof (struct subcontrol_image_instance, children) }, + { XD_LISP_OBJECT, offsetof (struct subcontrol_image_instance, width) }, + { XD_LISP_OBJECT, offsetof (struct subcontrol_image_instance, height) }, { XD_END } }; -static const struct sized_memory_description subwindow_image_instance_description = { - sizeof (struct subwindow_image_instance), subwindow_image_instance_description_1 +static const struct sized_memory_description subcontrol_image_instance_description = { + sizeof (struct subcontrol_image_instance), subcontrol_image_instance_description_1 }; static const struct memory_description image_instance_data_description_1 [] = { ＠＠ -882,7 +1584,7 ＠＠ { XD_BLOCK_ARRAY, IMAGE_COLOR_PIXMAP, 1, { &pixmap_image_instance_description } }, { XD_BLOCK_ARRAY, IMAGE_WIDGET, - 1, { &subwindow_image_instance_description } }, + 1, { &subcontrol_image_instance_description } }, { XD_END } }; ＠＠ -910,7 +1612,7 ＠＠ /* #### I want to check the instance here, but there are way too many instances of the instance being marked while the domain is dead. For instance you can get marked through an event when using - callback_ex.*/ + a callback. */ #if 0 ERROR_CHECK_IMAGE_INSTANCE (obj); #endif ＠＠ -945,7 +1647,8 ＠＠ case IMAGE_WIDGET: mark_object (IMAGE_INSTANCE_WIDGET_TYPE (i)); mark_object (IMAGE_INSTANCE_WIDGET_PROPS (i)); - mark_object (IMAGE_INSTANCE_SUBWINDOW_FACE (i)); + mark_object (IMAGE_INSTANCE_WIDGET_TAG (i)); + mark_object (IMAGE_INSTANCE_SUBCONTROL_FACE (i)); mark_object (IMAGE_INSTANCE_WIDGET_ITEMS (i)); mark_object (IMAGE_INSTANCE_LAYOUT_CHILDREN (i)); mark_object (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (i)); ＠＠ -1066,13 +1769,13 ＠＠ write_fmt_string (printcharfun, " %dx%d", IMAGE_INSTANCE_WIDTH (ii), IMAGE_INSTANCE_HEIGHT (ii)); - /* This is stolen from frame.c. Subwindows are strange in that they + /* This is stolen from frame.c. Subcontrols 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 (printcharfun, " on #<"); { - struct frame* f = XFRAME (IMAGE_INSTANCE_FRAME (ii)); + struct frame *f = XFRAME (IMAGE_INSTANCE_FRAME (ii)); if (!FRAME_LIVE_P (f)) write_c_string (printcharfun, "dead"); ＠＠ -1081,8 +1784,8 ＠＠ DEVICE_TYPE_NAME (XDEVICE (FRAME_DEVICE (f)))); } write_c_string (printcharfun, "-frame>"); - write_fmt_string (printcharfun, " 0x%p", - IMAGE_INSTANCE_SUBWINDOW_ID (ii)); + write_fmt_string (printcharfun, " 0x%x", + IMAGE_INSTANCE_SUBCONTROL_ID (ii)); break; ＠＠ -1178,8 +1881,8 ＠＠ case IMAGE_WIDGET: if (!(EQ (IMAGE_INSTANCE_WIDGET_TYPE (i1), IMAGE_INSTANCE_WIDGET_TYPE (i2)) - && IMAGE_INSTANCE_SUBWINDOW_ID (i1) == - IMAGE_INSTANCE_SUBWINDOW_ID (i2) + && IMAGE_INSTANCE_SUBCONTROL_ID (i1) == + IMAGE_INSTANCE_SUBCONTROL_ID (i2) && EQ (IMAGE_INSTANCE_WIDGET_FACE (i1), IMAGE_INSTANCE_WIDGET_TYPE (i2)) ＠＠ -1203,8 +1906,8 ＠＠ break; case IMAGE_SUBWINDOW: - if (!(IMAGE_INSTANCE_SUBWINDOW_ID (i1) == - IMAGE_INSTANCE_SUBWINDOW_ID (i2))) + if (!(IMAGE_INSTANCE_SUBCONTROL_ID (i1) == + IMAGE_INSTANCE_SUBCONTROL_ID (i2))) return 0; break; ＠＠ -1283,8 +1986,9 ＠＠ internal_hash (IMAGE_INSTANCE_WIDGET_ITEMS (i), depth + 1), internal_hash (IMAGE_INSTANCE_LAYOUT_CHILDREN (i), depth + 1)); + /* fall through */ case IMAGE_SUBWINDOW: - hash = HASH2 (hash, (EMACS_INT) IMAGE_INSTANCE_SUBWINDOW_ID (i)); + hash = HASH2 (hash, (EMACS_INT) IMAGE_INSTANCE_SUBCONTROL_ID (i)); break; default: ＠＠ -1297,21 +2001,32 ＠＠ 0)); } -DEFINE_LRECORD_IMPLEMENTATION ("image-instance", image_instance, - 0, /*dumpable-flag*/ - mark_image_instance, print_image_instance, - finalize_image_instance, image_instance_equal, - image_instance_hash, - image_instance_description, - Lisp_Image_Instance); +static Lisp_Object image_instance_getprop (Lisp_Object obj, Lisp_Object prop); +static int image_instance_putprop (Lisp_Object obj, Lisp_Object prop, + Lisp_Object value); +static int image_instance_remprop (Lisp_Object obj, Lisp_Object prop); +static Lisp_Object image_instance_plist (Lisp_Object obj); + +DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("image-instance", image_instance, + 0, /*dumpable-flag*/ + mark_image_instance, + print_image_instance, + finalize_image_instance, + image_instance_equal, + image_instance_hash, + image_instance_description, + image_instance_getprop, + image_instance_putprop, + image_instance_remprop, + image_instance_plist, + Lisp_Image_Instance); static Lisp_Object -allocate_image_instance (Lisp_Object governing_domain, Lisp_Object parent, - Lisp_Object instantiator) +initialize_image_instance (Lisp_Object image_instance, + Lisp_Object governing_domain, Lisp_Object parent, + Lisp_Object instantiator) { - Lisp_Image_Instance *lp = - alloc_lcrecord_type (Lisp_Image_Instance, &lrecord_image_instance); - Lisp_Object val; + Lisp_Image_Instance *lp = XIMAGE_INSTANCE (image_instance); /* It's not possible to simply keep a record of the domain in which the instance was instantiated. This is because caching may mean ＠＠ -1334,10 +2049,19 ＠＠ /* So that layouts get done. */ lp->layout_changed = 1; - val = wrap_image_instance (lp); MARK_GLYPHS_CHANGED; + + return wrap_image_instance (lp); +} - return val; +static Lisp_Object +allocate_image_instance (Lisp_Object governing_domain, Lisp_Object parent, + Lisp_Object instantiator) +{ + Lisp_Image_Instance *lp = + alloc_lcrecord_type (Lisp_Image_Instance, &lrecord_image_instance); + return initialize_image_instance (wrap_image_instance (lp), governing_domain, + parent, instantiator); } static enum image_instance_type ＠＠ -1446,8 +2170,10 ＠＠ DEFUN ("valid-image-instance-type-p", Fvalid_image_instance_type_p, 1, 1, 0, /* Given an IMAGE-INSTANCE-TYPE, return non-nil if it is valid. -Valid types are some subset of 'nothing, 'text, 'mono-pixmap, 'color-pixmap, -'pointer, 'subwindow, and 'widget, depending on how XEmacs was compiled. + +Valid types are some subset of `nothing', `text', `mono-pixmap', +`color-pixmap', `pointer', `subwindow', and `widget', depending on how +XEmacs was compiled. */ (image_instance_type)) { ＠＠ -1456,6 +2182,12 ＠＠ DEFUN ("image-instance-type-list", Fimage_instance_type_list, 0, 0, 0, /* Return a list of valid image-instance types. + +Valid types are some subset of `nothing', `text', `mono-pixmap', +`color-pixmap', `pointer', `subwindow', and `widget', depending on how +XEmacs was compiled. + +See `make-image-instance' for a discussion of what they mean. */ ()) { ＠＠ -1487,10 +2219,11 ＠＠ } } -/* Recurse up the hierarchy looking for the topmost glyph. This means +/* Recurse up the hierarchy looking for the topmost glyph. This means that instances in layouts will inherit face properties from their parent. */ -Lisp_Object image_instance_parent_glyph (Lisp_Image_Instance* ii) +Lisp_Object +image_instance_parent_glyph (Lisp_Image_Instance *ii) { if (IMAGE_INSTANCEP (IMAGE_INSTANCE_PARENT (ii))) { ＠＠ -1501,7 +2234,8 ＠＠ } static Lisp_Object -make_image_instance_1 (Lisp_Object data, Lisp_Object domain, +make_image_instance_1 (Lisp_Object overwrite_me, Lisp_Object parent, + Lisp_Object data, Lisp_Object domain, Lisp_Object dest_types) { Lisp_Object ii; ＠＠ -1526,47 +2260,131 ＠＠ invalid_argument ("Inheritance not allowed here", data); governing_domain = get_image_instantiator_governing_domain (data, domain); - ii = instantiate_image_instantiator (governing_domain, domain, data, - Qnil, Qnil, dest_mask, Qnil); + ii = instantiate_image_instantiator (governing_domain, domain, data, Qnil, + Qnil, dest_mask, parent, overwrite_me); + + + /* Put the image instance into the cache. Necessary esp. for subcontrols + so that they get unmapped/located properly. */ + + { + Lisp_Object table = Qnil; + Lisp_Object hash_key = Qnil; + + if (DEVICEP (governing_domain)) + { + table = XDEVICE (governing_domain)->image_instance_cache; + hash_key = list3 (ii, INSTANTIATOR_TYPE (data), make_int (dest_mask)); + } + else if (WINDOWP (governing_domain)) + { + table = XWINDOW_XFRAME (governing_domain)->subcontrol_instance_cache; + hash_key = list5 (ii, governing_domain, Qnil, Qnil, Qnil); + } + else + ABORT (); + + Fputhash (hash_key, ii, table); + } + RETURN_UNGCPRO (ii); } +/* This is exactly like Fmake_image_instance() except that if OVERWRITE_ME + is non-nil, it attempts to overwrite an existing image instance. This + is used when instantiating widgets for efficiency (to avoid lots of + excessive flashing) and so as to preserve reasonable semantics involving + image instances (if you're a callback function holding on to an image + instance and you change the instantiator, your image instance should + still be valid, just with different properties). The governing domain + of the existing image instance must be the same as the new governing + domain as determined from DOMAIN, or we will abort. Currently we can + only overwrite an image instance with the same instantiator type (see + instantiate_image_instantiator()); otherwise, we get a new one. + + We don't currently expose this to Lisp because it's probably not a good + idea to do so. */ + +Lisp_Object +overwrite_image_instance (Lisp_Object overwrite_me, + Lisp_Object data, Lisp_Object parent, + Lisp_Object domain, + Lisp_Object dest_types, + Lisp_Object noerror) +{ + Error_Behavior errb = decode_error_behavior_flag (noerror); + if (!NILP (overwrite_me)) + CHECK_IMAGE_INSTANCE (overwrite_me); + + return call_with_suspended_errors ((lisp_fn_t) make_image_instance_1, + Qnil, Qimage, errb, + 5, overwrite_me, parent, data, domain, + dest_types); +} + DEFUN ("make-image-instance", Fmake_image_instance, 1, 4, 0, /* Return a new `image-instance' object. -Image-instance objects encapsulate the way a particular image (pixmap, -etc.) is displayed on a particular device. In most circumstances, you -do not need to directly create image instances; use a glyph instead. -However, it may occasionally be useful to explicitly create image -instances, if you want more control over the instantiation process. +Image-instance objects encapsulate the way a particular glyph (pixmap, +widget, etc.) is displayed on a particular device. In most circumstances, +you do not need to directly create image instances; instead, you create a +glyph using `make-glyph' and add settings (or "instantiators") onto it +using `set-glyph-image', and XEmacs creates the image instances as +necessary. However, it may occasionally be useful to explicitly create +image instances, if you want more control over the instantiation process. + +For more information on instantiators and instances, see `make-specifier'. + +DATA is an image instantiator, which describes the image; see `make-glyph' +for a description of the allowed values. + +The most likely circumstance where you need to deal directly with image +instances is in widget callbacks -- e.g. the callback that's executed when +a button is pressed in a dialog box of type `general' (see +`make-dialog-box'). In this case, the widget that was activated is +described by an image instance. (The callback is usually be written as an +interactive function with an interactive spec of (interactive \"e\"), and a +single `event' argument. The event will be an activate event, describing +the user action that trigged the callback. The image instance is +retrievable from the event using `event-image-instance'. Handling the +action may involve setting properties on the image instance or other image +instances in the dialog box in which the widget is usually contained -- or +changing the instantiator that generated the image instance, if you want +permanent changes that will be reflected the next time the dialog box is +popped up. Properties on an image instance are set using +`set-image-instance-property'. If the widget is part of a hierarchy of +widgets (as is usually the case in a dialog box, but may not apply if the +widget was inserted by itself in a buffer [by creating a glyph and +attaching it to an extent -- see `make-glyph']), there will be a +corresponding hierarchy of image instances to describe this particular +instance of the dialog box. You can retrieve other image instances in the +hierarchy using primitives such as `image-instance-parent', +`image-instance-children', and `find-image-instance'. -DATA is an image instantiator, which describes the image; see -`make-image-specifier' for a description of the allowed values. - DEST-TYPES should be a list of allowed image instance types that can be generated. The recognized image instance types are -'nothing +`nothing' Nothing is displayed. -'text +`text' Displayed as text. The foreground and background colors and the font of the text are specified independent of the pixmap. Typically these attributes will come from the face of the surrounding text, unless a face is specified for the glyph in which the image appears. -'mono-pixmap +`mono-pixmap' Displayed as a mono pixmap (a pixmap with only two colors where the foreground and background can be specified independent of the pixmap; typically the pixmap assumes the foreground and background colors of the text around it, unless a face is specified for the glyph in which the image appears). -'color-pixmap +`color-pixmap' Displayed as a color pixmap. -'pointer +`pointer' Used as the mouse pointer for a window. -'subwindow +`subwindow' A child window that is treated as an image. This allows (e.g.) another program to be responsible for drawing into the window. -'widget +`widget' A child window that contains a window-system widget, e.g. a push button, text field, or slider. ＠＠ -1587,8 +2405,50 ＠＠ succeeds, passing less and less preferred destination types each time.) -See `make-image-specifier' for a description of the different image -instantiator formats. +It is important to keep the distinction between image instantiator format +and image instance type in mind. Typically, a given image instantiator +format can result in many different image instance types (for example, +`xpm' can be instanced as `color-pixmap', `mono-pixmap', or `pointer'; +whereas `cursor-font' can be instanced only as `pointer'), and a particular +image instance type can be generated by many different image instantiator +formats (e.g. `color-pixmap' can be generated by `xpm', `gif', `jpeg', +etc.). + +See `make-glyph' for a description of the different image instantiator +formats. + +An approximate mapping between image instantiator formats and the possible +resulting image instance types is as follows: + + image instantiator format image instance type + ------------------------- ------------------- + nothing nothing + string text + formatted-string text + xbm mono-pixmap, color-pixmap, pointer + xpm color-pixmap, mono-pixmap, pointer + xface mono-pixmap, color-pixmap, pointer + gif color-pixmap + jpeg color-pixmap + png color-pixmap + tiff color-pixmap + bmp color-pixmap + cursor-font pointer + mswindows-resource pointer, color-pixmap + font pointer + subwindow subwindow + inherit mono-pixmap + autodetect mono-pixmap, color-pixmap, pointer, text + button widget + edit-field widget + combo-box widget + progress-gauge widget + tab-control widget + tree-view widget + scrollbar widget + label widget + layout widget + native-layout widget If DEST-TYPES is omitted, all possible types are allowed. ＠＠ -1631,7 +2491,7 ＠＠ return call_with_suspended_errors ((lisp_fn_t) make_image_instance_1, Qnil, Qimage, errb, - 3, data, domain, dest_types); + 5, Qnil, Qnil, data, domain, dest_types); } DEFUN ("image-instance-p", Fimage_instance_p, 1, 1, 0, /* ＠＠ -1644,8 +2504,8 ＠＠ DEFUN ("image-instance-type", Fimage_instance_type, 1, 1, 0, /* Return the type of the given image instance. -The return value will be one of 'nothing, 'text, 'mono-pixmap, -'color-pixmap, 'pointer, 'subwindow, or 'widget. +The return value will be one of `nothing', `text', `mono-pixmap', +`color-pixmap', `pointer', `subwindow' or `widget'. */ (image_instance)) { ＠＠ -1663,61 +2523,184 ＠＠ return XIMAGE_INSTANCE_NAME (image_instance); } -DEFUN ("image-instance-instantiator", Fimage_instance_instantiator, 1, 1, 0, /* -Return the instantiator that was used to create the image instance. -*/ - (image_instance)) -{ - CHECK_IMAGE_INSTANCE (image_instance); - return XIMAGE_INSTANCE_INSTANTIATOR (image_instance); +/* Map MAPPER over IMAGE_INSTANCE and all its children. MAPPER is called + with two arguments, the image instance and the ARG provided to + map_image_instance_children(). If the mapper ever returns non-zero, + mapping stops and the value is returned. */ + +static int +map_image_instance_children (Lisp_Object image_instance, + int (*mapper) (Lisp_Object image_instance, + void *arg), + void *arg) +{ + /* #### Should we do breadth-first? Should we provide this as an option? */ + int result = mapper (image_instance, arg); + if (result) + return result; + if (XIMAGE_INSTANCE_TYPE (image_instance) != IMAGE_WIDGET) + return 0; + { + LIST_LOOP_2 (child, XIMAGE_INSTANCE_LAYOUT_CHILDREN (image_instance)) + { + result = map_image_instance_children (child, mapper, arg); + if (result) + return result; + } + } + return result; } -DEFUN ("image-instance-domain", Fimage_instance_domain, 1, 1, 0, /* -Return the governing domain of the given image instance. -The governing domain of an image instance is the domain that the image -instance is specific to. It is NOT necessarily the domain that was -given to the call to `specifier-instance' that resulted in the creation -of this image instance. See `make-image-instance' for more information -on governing domains. -*/ - (image_instance)) +static int +slow_lisp_mapper (Lisp_Object image_instance, void *arg) { - CHECK_IMAGE_INSTANCE (image_instance); - return XIMAGE_INSTANCE_DOMAIN (image_instance); + call1 (VOID_TO_LISP (arg), image_instance); + return 0; } -DEFUN ("image-instance-string", Fimage_instance_string, 1, 1, 0, /* -Return the string of the given image instance. -This will only be non-nil for text image instances and widgets. +DEFUN ("map-image-instance", Fmap_image_instance, 2, 2, 0, /* +Map FUNCTION over IMAGE-INSTANCE and its children. +FUNCTION is called with one argument, the image instance. */ - (image_instance)) + (function, image_instance)) { CHECK_IMAGE_INSTANCE (image_instance); - if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_TEXT) - return XIMAGE_INSTANCE_TEXT_STRING (image_instance); - else if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_WIDGET) - return XIMAGE_INSTANCE_WIDGET_TEXT (image_instance); - else - return Qnil; + CHECK_FUNCTION (function); + map_image_instance_children (image_instance, slow_lisp_mapper, + LISP_TO_VOID (function)); + return Qnil; } -DEFUN ("image-instance-property", Fimage_instance_property, 2, 2, 0, /* -Return the given property of the given image instance. -Returns nil if the property or the property method do not exist for -the image instance in the domain. -*/ - (image_instance, prop)) +struct find_ii_arg { - Lisp_Image_Instance* ii; - Lisp_Object type, ret; - struct image_instantiator_methods* meths; + Lisp_Object prop; + Lisp_Object val; + Lisp_Object result; +}; + +static int +find_ii_mapper (Lisp_Object image_instance, void *arg) +{ + struct find_ii_arg *a = (struct find_ii_arg *) arg; + if (!NILP (Fequal (Fget (image_instance, a->prop, Qunbound), + a->val))) + { + a->result = image_instance; + return 1; + } + + return 0; +} + +DEFUN ("find-image-instance", Ffind_image_instance, 3, 3, 0, /* +Search recursively among the children of IMAGE-INSTANCE. +Return the first image instance whose PROP property has VAL as its value. +Searching is (currently) always depth-first. +Return nil if no image instance found. +*/ + (image_instance, prop, val)) +{ + struct find_ii_arg arg; + + CHECK_IMAGE_INSTANCE (image_instance); + CHECK_SYMBOL (prop); + + arg.prop = prop; + arg.val = val; + arg.result = Qnil; + + if (!map_image_instance_children (image_instance, find_ii_mapper, + &arg)) + return Qnil; + return arg.result; +} + +DEFUN ("focus-image-instance", Ffocus_image_instance, 1, 1, 0, /* +Search recursively among the children of IMAGE-INSTANCE. +Return the first image instance whose PROP property has VAL as its value. +Searching is (currently) always depth-first. +Return nil if no image instance found. +*/ + (image_instance)) +{ + CHECK_IMAGE_INSTANCE (image_instance); + /* ^^#### implement me */ + return Qnil; +} + +DEFUN ("image-instance-parent", Fimage_instance_parent, 1, 1, 0, /* +Return the parent of the given image instance. +This can be another image instance (in a layout tree of widgets), or if +there is no such image instance parent, the glyph that the image instance +is attached to, if any. +*/ + (image_instance)) +{ + CHECK_IMAGE_INSTANCE (image_instance); + return XIMAGE_INSTANCE_PARENT (image_instance); +} + +DEFUN ("image-instance-children", Fimage_instance_children, 1, 1, 0, /* +Return the children of the given image instance. +This will be nil if the image instance is not a layout widget. +*/ + (image_instance)) +{ + CHECK_IMAGE_INSTANCE (image_instance); + if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_WIDGET) + return Fcopy_sequence (XIMAGE_INSTANCE_LAYOUT_CHILDREN (image_instance)); + else + return Qnil; +} + +DEFUN ("image-instance-domain", Fimage_instance_domain, 1, 1, 0, /* +Return the governing domain of the given image instance. +The governing domain of an image instance is the domain that the image +instance is specific to. It is NOT necessarily the domain that was +given to the call to `specifier-instance' that resulted in the creation +of this image instance. See `make-image-instance' for more information +on governing domains. +*/ + (image_instance)) +{ + CHECK_IMAGE_INSTANCE (image_instance); + return XIMAGE_INSTANCE_DOMAIN (image_instance); +} + +DEFUN ("image-instance-string", Fimage_instance_string, 1, 1, 0, /* +Return the string of the given image instance. +This will only be non-nil for text image instances and widgets. +*/ + (image_instance)) +{ + CHECK_IMAGE_INSTANCE (image_instance); + if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_TEXT) + return XIMAGE_INSTANCE_TEXT_STRING (image_instance); + else if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_WIDGET) + return XIMAGE_INSTANCE_WIDGET_TEXT (image_instance); + else + return Qnil; +} + +static Lisp_Object +image_instance_getprop (Lisp_Object image_instance, Lisp_Object prop) +{ + Lisp_Image_Instance *ii; + Lisp_Object type, ret; + struct image_instantiator_methods *meths; CHECK_IMAGE_INSTANCE (image_instance); ERROR_CHECK_IMAGE_INSTANCE (image_instance); CHECK_SYMBOL (prop); ii = XIMAGE_INSTANCE (image_instance); - /* ... then try device specific methods ... */ + /* + ^^#### document me better; also figure out why there's this confusion + between instantiator formats and image instance types -- probably a bug. + in general, image-instance-property needs to return all the properties + that can be obtained through more specific image-instance-* primitives. */ + + /* try device-specific/format-specific methods first ... */ type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii)); meths = decode_device_ii_format (image_instance_device (image_instance), type, ERROR_ME_NOT); ＠＠ -1727,7 +2710,7 ＠＠ { return ret; } - /* ... then format specific methods ... */ + /* ... then generic format-specific methods ... */ meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT); if (meths && HAS_IIFORMAT_METH_P (meths, property) && ＠＠ -1736,7 +2719,344 ＠＠ return ret; } /* ... then fail */ - return Qnil; + return Qunbound; +} + +static int +image_instance_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value) +{ + return 0; /* ^^#### */ +} + +static int +image_instance_remprop (Lisp_Object obj, Lisp_Object prop) +{ + return -1; /* ^^#### */ +} + +static Lisp_Object +image_instance_plist (Lisp_Object obj) +{ + return Qnil; /* ^^#### */ +} + +DEFUN ("make-instantiator", Fmake_instantiator, 1, MANY, 0, /* +Create a new instantiator object from TYPE and PROPS. +TYPE should be one of the image instantiator formats described in `make-glyph'. +The rest of the arguments should be keyword properties and associated values, +as also described in `make-glyph'. + +TYPE can also be an old-style vector instantiator. + +Instantiator objects can be used as instantiators (see `make-specifier') in +glyphs in place of old-style vector instantiators. They are especially +used for complicated, nested graphical elements such as widgets (buttons, +text fields, etc.) -- in fact, widget instantiators will automatically be +converted into instantiator objects if they are given in vector format. + +Individual properties on instantiators can be manipulated using +`set-instantiator-property'. If the property's value is a list (for +example, a list of children), you can also use `add-instantiator-item' +to add or insert individual elements in the list. + +`delete-instantiator-item' can be used to delete individual items in the list; +`get-instantiator-item' to locate individual items in the list; and +`get-instantiator-item-position' to return the position of individual items in +the list. + +`map-instantiator' can be used to (recursively or not) map over an +instantiator and its children. + +`find-instantiator' can be used to (recursively or not) locate an instantiator +in a tree composed of an instantiator and its descendants. +*/ + /* (type &rest props) */ + (int nargs, Lisp_Object *args)) +{ + /* ^^#### */ return Qnil; +} + +DEFUN ("set-instantiator-property", Fset_instantiator_property, 3, 3, 0, /* +Set property PROP to VALUE in INSTANTIATOR. +INSTANTIATOR should have been created with `make-instantiator'. +Valid properties depend on the instantiator type and are described in +`make-glyph'. For properties that are lists of items, individual items +can be added or deleted using `add-instantiator-item' and +`delete-instantiator-item'. + +For compatibility, this also accepts an old-style vector instantiator, and +destructively modifies it; in this case, adding a property requires +creating a new vector, which is returned. You need to use +`set-glyph-image' on glyphs, or `set-specifier-dirty-flag' on the result of +`glyph-image', to register instantiator changes to vector +instantiators. (New-style instantiators automatically convey property +changes to any glyphs they have been attached to.) +*/ + (instantiator, prop, value)) +{ + Lisp_Object *elt; + int len; + + /* ^^#### */ + CHECK_VECTOR (instantiator); + if (!KEYWORDP (prop)) + invalid_argument ("instantiator property must be a keyword", prop); + + elt = XVECTOR_DATA (instantiator); + len = XVECTOR_LENGTH (instantiator); + + for (len -= 2; len >= 1; len -= 2) + { + if (EQ (elt[len], prop)) + { + elt[len + 1] = value; + break; + } + } + + /* Didn't find it so add it. */ + if (len < 1) + { + Lisp_Object alist = Qnil, result; + struct gcpro gcpro1; + + GCPRO1 (alist); + alist = tagged_vector_to_alist (instantiator); + alist = Fcons (Fcons (prop, value), alist); + result = alist_to_tagged_vector (elt[0], alist); + free_alist (alist); + RETURN_UNGCPRO (result); + } + + return instantiator; +} + +DEFUN ("instantiator-property", Finstantiator_property, 2, 3, 0, /* +Return the property PROP of INSTANTIATOR, or DEFAULT if PROP has no value. +INSTANTIATOR should have been created with `make-instantiator'. +*/ + (instantiator, prop, default_)) +{ + /* ^^#### */ return Qnil; +} + +DEFUN ("instantiator-properties", Finstantiator_properties, 1, 1, 0, /* +Return a plist of all defined properties in INSTANTIATOR. +INSTANTIATOR should have been created with `make-instantiator'. +*/ + (instantiator)) +{ + /* ^^#### */ return Qnil; +} + +DEFUN ("instantiator-type", Finstantiator_type, 1, 1, 0, /* +Return the type of INSTANTIATOR. +INSTANTIATOR should have been created with `make-instantiator'. +Valid types are the instantiator formats described in `make-glyph'. +*/ + (instantiator)) +{ + /* ^^#### */ return Qnil; +} + +DEFUN ("instantiator-parent", Finstantiator_parent, 1, 1, 0, /* +Return the parent of INSTANTIATOR. +INSTANTIATOR should have been created with `make-instantiator'. +*/ + (instantiator)) +{ + /* ^^#### */ return Qnil; +} + +DEFUN_WITH_KEYWORDS ("map-instantiator", Fmap_instantiator, 2, 2, 1, 0, 0, /* +Map FUN recursively over INSTANTIATOR and its descendants. +FUN is called with one argument, the INSTANTIATOR. +If :norecurse is non-nil, don't recurse, just map over the direct +children (not including the instantiator itself). +*/ + (fun, instantiator), + (norecurse)) +{ + /* ^^#### */ return Qnil; +} + +DEFUN_WITH_KEYWORDS ("find-instantiator", Ffind_instantiator, 3, 3, + 1, 0, 0, /* +Find an instantiator by PROP and VALUE in INSTANTIATOR and its descendants. +Returns first item which has PROP set to VALUE. +If :norecurse is non-nil, don't recurse, just look through the direct +children (not including the instantiator itself). +*/ + (instantiator, prop, value), + (norecurse)) +{ + /* ^^#### */ return Qnil; +} + +DEFUN_WITH_KEYWORDS ("add-instantiator-item", Fadd_instantiator_item, 3, 3, 7, + 0, 0, /* +Add an item to an instantiator property that's a list of items. +\(E.g. the children of an instantiator). PROP is the property whose list of +items is being modified, and ITEM is the item to add. To insert somewhere +before the end, use one of the keywords: + +-- :position specifies a zero-based index of an item, and the new item will be +inserted just before the item indicated by the position. Negative numbers +count from the end -- thus -1 will cause insertion before the last item, -2 +before the second-to-last item, etc. + +-- :before-item and :after-item specify items to insert before or after. +:test (defaults to `eq') can be used to specify the way to compare the given +item with existing items. + +-- :before-property and :after-property search for an item to insert before or +after by looking for an item with the given property. If :value is given, the +property must have that value; otherwise, it simply must exist. This method +of insertion works if the items in PROP's list are anything that can have or +hold properties. \("To have and to hold, for ever and ever ...") This +includes: + +-- any object for which `get' works +-- else, if object is a vector, assume it's a plist-style vector +-- else, if object is a cons, and its first element is also a cons, + assume it's an alist +-- else, if object is a cons, assume it's a plist +*/ + (instantiator, prop, item), + (position, before_item, after_item, test, + before_property, after_property, value)) +{ + /* ^^#### */ + Lisp_Object result = Qnil; +#define FROB(val) result = cons3 (val, build_string (#val), result) + FROB (instantiator); + FROB (prop); + FROB (item); + FROB (position); + FROB (before_item); + FROB (after_item); + FROB (test); + FROB (before_property); + FROB (after_property); + FROB (value); +#undef FROB + + return Fnreverse (result); +} + +DEFUN_WITH_KEYWORDS ("delete-instantiator-item", Fdelete_instantiator_item, + 2, 2, 5, ALLOW_OTHER_DEFAULT_UNBOUND, 0, /* +Delete an item in an instantiator property that's a list of items. + +\(E.g. the children of an instantiator). PROP is the property whose list is +being searched. One of these keywords should be given: + +-- :position specifies a zero-based index of an item. Negative numbers +count from the end -- thus -1 will cause insertion before the last item, -2 +before the second-to-last item, etc. + +-- :item specifies the item to delete. :test (defaults to `eq') can be used to +specify the way to compare the given item with existing items. + +-- :property searches for an item with the given property. If :value is +given, the property must have that value; otherwise, it simply must exist. +This method of insertion works if the items in PROP's list are anything that +can have or hold properties -- see `add-instantiator-item'. +*/ + (instantiator, prop), + (item, test, position, property, value)) +{ + /* ^^#### */ + Lisp_Object result = + list1 (make_plist_from_lisp_object_pair_array (num_other_keywords, + other_keywords)); +#define FROB(val) result = cons3 (val, build_string (#val), result) + FROB (instantiator); + FROB (prop); + FROB (item); + FROB (test); + FROB (position); + FROB (property); + FROB (value); +#undef FROB + + return Fnreverse (result); +} + +DEFUN_WITH_KEYWORDS ("get-instantiator-item", Fget_instantiator_item, + 2, 2, 3, ALLOW_OTHER, 0, /* +Get an item in an instantiator property that's a list of items. + +\(E.g. the children of an instantiator). PROP is the property whose list is +being searched. One of these keywords should be given: + +-- :position specifies a zero-based index of an item. Negative numbers count +from the end -- thus -1 will cause insertion before the last item, -2 before +the second-to-last item, etc. + +-- :property searches for an item with the given property. If :value is +given, the property must have that value; otherwise, it simply must exist. +This method of insertion works if the items in PROP's list are anything that +can have or hold properties -- see `add-instantiator-item'. +*/ + (instantiator, prop), + (position, property, value)) +{ + /* ^^#### */ + Lisp_Object result = + list1 (make_plist_from_lisp_object_pair_array (num_other_keywords, + other_keywords)); +#define FROB(val) result = cons3 (val, build_string (#val), result) + FROB (instantiator); + FROB (prop); + FROB (position); + FROB (property); + FROB (value); +#undef FROB + + return Fnreverse (result); +} + +DEFUN_WITH_KEYWORDS ("get-instantiator-item-position", + Fget_instantiator_item_position, + 2, 2, 4, DEFAULT_UNBOUND, 0, /* +Return an item's position in an instantiator property that's a list of items. + +\(E.g. the children of an instantiator). PROP is the property whose list is +being searched. One of these keywords should be given: + +-- :item specifies the item to search for. :test (defaults to `eq') can be +used to specify the way to compare the given item with existing items. + +-- :property searches for an item with the given property. If :value is +given, the property must have that value; otherwise, it simply must exist. +This method of insertion works if the items in PROP's list are anything that +can have or hold properties -- see `add-instantiator-item'. +*/ + (instantiator, prop), + (item, test, property, value)) +{ + /* ^^#### */ + Lisp_Object result = Qnil; +#define FROB(val) result = cons3 (val, build_string (#val), result) + FROB (instantiator); + FROB (prop); + FROB (item); + FROB (test); + FROB (property); + FROB (value); +#undef FROB + + return Fnreverse (result); +} + +DEFUN ("image-instance-instantiator", Fimage_instance_instantiator, 1, 1, 0, /* +Return the instantiator that was used to create the image instance. +*/ + (image_instance)) +{ + CHECK_IMAGE_INSTANCE (image_instance); + return XIMAGE_INSTANCE_INSTANTIATOR (image_instance); } DEFUN ("image-instance-file-name", Fimage_instance_file_name, 1, 1, 0, /* ＠＠ -1912,10 +3232,8 ＠＠ return XIMAGE_INSTANCE_PIXMAP_FG (image_instance); case IMAGE_WIDGET: - return FACE_FOREGROUND ( - XIMAGE_INSTANCE_WIDGET_FACE (image_instance), - XIMAGE_INSTANCE_FRAME - (image_instance)); + return FACE_FOREGROUND (XIMAGE_INSTANCE_WIDGET_FACE (image_instance), + XIMAGE_INSTANCE_FRAME (image_instance)); default: return Qnil; ＠＠ -1995,13 +3313,13 ＠＠ special function then just return the width and / or height. */ void image_instance_query_geometry (Lisp_Object image_instance, - int* width, int* height, + int *width, int *height, enum image_instance_geometry disp, Lisp_Object domain) { - Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance); + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object type; - struct image_instantiator_methods* meths; + struct image_instantiator_methods *meths; ERROR_CHECK_IMAGE_INSTANCE (image_instance); type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii)); ＠＠ -2034,9 +3352,9 ＠＠ int xoffset, int yoffset, Lisp_Object domain) { - Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance); + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object type; - struct image_instantiator_methods* meths; + struct image_instantiator_methods *meths; ERROR_CHECK_IMAGE_INSTANCE (image_instance); ＠＠ -2102,13 +3420,29 ＠＠ us at the end. */ IMAGE_INSTANCE_LAYOUT_CHANGED (ii) = 0; } + +/* Update an image instance from its changed instantiator. This happens + either the first time we create an image instance, or when an + instantiator changes after we've already instantiated the glyph. Note + that image instances are per-glyph and per-governing-domain (window for + subcontrols, else device), as well as per-ii-format (^^#### document + why). We use hash tables to keep track of the image instances we've + created, so that a change to the instantiator will change an existing + image instance rather than make a new one. See comment at beginning of + file. + + #### This function should be able to cope with *all* changes to the + #### instantiator, but currently only copes with the most used + #### properties. This means that it is possible to make changes that + #### don't get reflected in the display. +*/ -/* Update an image instance from its changed instantiator. */ static void update_image_instance (Lisp_Object image_instance, - Lisp_Object instantiator) + Lisp_Object instantiator, + Lisp_Object domain) { - struct image_instantiator_methods* meths; + struct image_instantiator_methods *meths; Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); ERROR_CHECK_IMAGE_INSTANCE (image_instance); ＠＠ -2117,8 +3451,10 ＠＠ return; assert (!internal_equal (IMAGE_INSTANCE_INSTANTIATOR (ii), instantiator, 0) - || (internal_equal (IMAGE_INSTANCE_INSTANTIATOR (ii), instantiator, 0) - && internal_equal (IMAGE_INSTANCE_INSTANTIATOR (ii), instantiator, -10))); + || (internal_equal (IMAGE_INSTANCE_INSTANTIATOR (ii), instantiator, + 0) + && internal_equal (IMAGE_INSTANCE_INSTANTIATOR (ii), instantiator, + -10))); /* If the instantiator is identical then do nothing. We must use equal here because the specifier code copies the instantiator. */ ＠＠ -2126,22 +3462,24 ＠＠ { /* Extract the changed properties so that device / format methods only have to cope with these. We assume that - normalization has already been done. */ + normalization has already been done. + + ^^#### certainly we need to record deleted properties as well as + added ones. */ Lisp_Object diffs = find_instantiator_differences - (instantiator, - IMAGE_INSTANCE_INSTANTIATOR (ii)); + (instantiator, IMAGE_INSTANCE_INSTANTIATOR (ii)); Lisp_Object type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii)); struct gcpro gcpro1; GCPRO1 (diffs); - /* try device specific methods first ... */ + /* try device-specific/format-specific methods first ... */ meths = decode_device_ii_format (image_instance_device (image_instance), type, ERROR_ME_NOT); - MAYBE_IIFORMAT_METH (meths, update, (image_instance, diffs)); - /* ... then format specific methods ... */ + MAYBE_IIFORMAT_METH (meths, update, (image_instance, diffs, domain)); + /* ... then generic format-specific methods ... */ meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT); - MAYBE_IIFORMAT_METH (meths, update, (image_instance, diffs)); + MAYBE_IIFORMAT_METH (meths, update, (image_instance, diffs, domain)); /* Instance and therefore glyph has changed so mark as dirty. If we don't do this output optimizations will assume the ＠＠ -2169,27 +3507,20 ＠＠ * Return non-zero if instance has been marked dirty. */ int -invalidate_glyph_geometry_maybe (Lisp_Object glyph_or_ii, struct window* w) +invalidate_glyph_geometry_maybe (Lisp_Object glyph_or_ii, struct window *w, + Lisp_Object matchspec) { - if (XFRAME(WINDOW_FRAME(w))->faces_changed) + if (XFRAME (WINDOW_FRAME (w))->faces_changed) { - Lisp_Object image = glyph_or_ii; - if (GLYPHP (glyph_or_ii)) - { - Lisp_Object window = wrap_window (w); - - image = glyph_image_instance (glyph_or_ii, window, - ERROR_ME_DEBUG_WARN, 1); - } + glyph_or_ii = glyph_image_instance (glyph_or_ii, wrap_window (w), + matchspec, + ERROR_ME_DEBUG_WARN, 1); - if (TEXT_IMAGE_INSTANCEP (image)) + if (TEXT_IMAGE_INSTANCEP (glyph_or_ii)) { - Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image); - IMAGE_INSTANCE_DIRTYP (ii) = 1; - IMAGE_INSTANCE_LAYOUT_CHANGED (ii) = 1; - if (GLYPHP (glyph_or_ii)) - XGLYPH_DIRTYP (glyph_or_ii) = 1; + set_image_instance_dirty_p (glyph_or_ii, 1); + IMAGE_INSTANCE_LAYOUT_CHANGED (XIMAGE_INSTANCE (glyph_or_ii)) = 1; return 1; } } ＠＠ -2357,7 +3688,7 ＠＠ helper that is used elsewhere for calculating text geometry. */ void query_string_geometry (Lisp_Object string, Lisp_Object face, - int* width, int* height, int* descent, Lisp_Object domain) + int *width, int *height, int *descent, Lisp_Object domain) { struct font_metric_info fm; unsigned char charsets[NUM_LEADING_BYTES]; ＠＠ -2447,7 +3778,7 ＠＠ static void text_query_geometry (Lisp_Object image_instance, - int* width, int* height, + int *width, int *height, enum image_instance_geometry UNUSED (disp), Lisp_Object domain) { ＠＠ -2465,7 +3796,8 ＠＠ /* set the properties of a string */ static void -text_update (Lisp_Object image_instance, Lisp_Object instantiator) +text_update (Lisp_Object image_instance, Lisp_Object instantiator, + Lisp_Object domain) { Lisp_Object val = find_keyword_in_vector (instantiator, Q_data); ＠＠ -2482,18 +3814,6 ＠＠ ****************************************************************************/ static void -formatted_string_validate (Lisp_Object instantiator) -{ - data_must_be_present (instantiator); -} - -static int -formatted_string_possible_dest_types (void) -{ - return IMAGE_TEXT_MASK; -} - -static void formatted_string_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, Lisp_Object pointer_fg, Lisp_Object pointer_bg, ＠＠ -3157,115 +4477,235 ＠＠ mark_object (IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image)); } +/* Equal and hash for caches used when instantiating images -- compare + the elements of the list using `eq'. */ static int -instantiator_eq_equal (Lisp_Object obj1, Lisp_Object obj2) +image_instance_cache_key_eq_equal (Lisp_Object obj1, Lisp_Object obj2) { if (EQ (obj1, obj2)) return 1; else if (CONSP (obj1) && CONSP (obj2)) { - return instantiator_eq_equal (XCAR (obj1), XCAR (obj2)) + return image_instance_cache_key_eq_equal (XCAR (obj1), XCAR (obj2)) && - instantiator_eq_equal (XCDR (obj1), XCDR (obj2)); + image_instance_cache_key_eq_equal (XCDR (obj1), XCDR (obj2)); } return 0; } static Hashcode -instantiator_eq_hash (Lisp_Object obj) +image_instance_cache_key_eq_hash (Lisp_Object obj) { if (CONSP (obj)) { /* no point in worrying about tail recursion, since we're not going very deep */ - return HASH2 (instantiator_eq_hash (XCAR (obj)), - instantiator_eq_hash (XCDR (obj))); + return HASH2 (image_instance_cache_key_eq_hash (XCAR (obj)), + image_instance_cache_key_eq_hash (XCDR (obj))); } return LISP_HASH (obj); } -/* We need a special hash table for storing image instances. */ -Lisp_Object -make_image_instance_cache_hash_table (void) +static int +image_instance_device_cache_weak (const htentry *e) { - return make_general_lisp_hash_table - (instantiator_eq_hash, instantiator_eq_equal, - 30, -1.0, -1.0, - HASH_TABLE_KEY_CAR_VALUE_WEAK); + /* The device cache hash keys are lists of (SPECIFIER-OR-IMAGE-INSTANCE + FORMAT-TYPE) and the values are image instances (success) or + instantiators (failure). Keep the entry if the specifier or value is + referenced elsewhere. */ + if (marked_p (XCAR (e->key))) + return mark_object_if_not (e->key) + mark_object_if_not (e->value); + else if (marked_p (e->value)) + return mark_object_if_not (e->key); + return 0; } -static Lisp_Object -image_instantiate_cache_result (Lisp_Object locative) +static int +image_instance_frame_cache_weak (const htentry *e) { - /* locative = (instance instantiator . subtable) + /* The frame cache hash keys are lists of (SPECIFIER-OR-IMAGE-INSTANCE + WINDOW MATCHSPEC END-GLYPH-P FORMAT-TYPE) and the values are image + instances (success) or instantiators (failure). + + Reject if MATCHSPEC not marked. + + Reject if MATCHSPEC is dead (depends on type of MATCHSPEC). + + Reject if the window is dead or unmarked. + + If MATCHSPEC is an extent, then the specifier ought to match the + extent's begin or end glyph, according to END-GLYPH-P. If not, the + extent's glyph was changed, and this entry is no longer valid, so + reject it. + + If MATCHSPEC is a toolbar button, then the specifier ought to match + one of the glyphs in the button. If not, the toolbar button was + changed and no longer contains the glyph, so reject it. + + If MATCHSPEC is an image instance, look in the instantiator for a + :images property. If it exists and it's a glyph, but it's not the + right glyph, reject it. + + (We need END-GLYPH-P because potentially an extent's begin-glyph + and end-glyph could both be displayed at once. For toolbar buttons, + only one image can be displayed at a time, and only one glyph hangs + off of widgets.) + + If MATCHSPEC is a cons, the glyph is from `modeline-format'. + END-GLYPH-P indicates whether to look at the car or cdr of the cons. + + If MATCHSPEC is Qmodeline, the glyph was the value of + `global-mode-string'. + + If MATCHSPEC is Qunbound, we're processing a built-in glyph or + display-table glyph, and can't come up with a suitable MATCHSPEC; so + we disallow subcontrols. + + #### Insert other checks to make sure that the glyph actually belongs + in the matchspec. If we don't do that, we could potentially end up + with lots of extra entries in the cache that are worthless but never + going away. (This assumes that the glyph itself is referenced + somewhere.) + + Else accept if the specifier or value is referenced elsewhere. */ + Lisp_Object specifier = XCAR (e->key); + Lisp_Object window = XCAR (XCDR (e->key)); + Lisp_Object matchspec = XCAR (XCDR (XCDR (e->key))); + Lisp_Object end_glyph_p = XCAR (XCDR (XCDR (XCDR (e->key)))); + Lisp_Object glyph = Qnil; + + /* Keep in mind that the user could potentially call `specifier-instance' + on some user-created specifier (attachee will not be a glyph or face) + and could pass in any MATCHSPEC -- so we have to be defensive in our + checks below. However, if "SPECIFIER" is not a specifier, it means + that the C code stuck in an entry during image instance creation, and + MATCHSPEC should be nil. */ + glyph_checking_assert (WINDOWP (window)); + glyph_checking_assert (SPECIFIERP (specifier) || NILP (matchspec)); - So we are using the instantiator as the key and the instance as - the value. Since the hashtable is key-weak this means that the - image instance will stay around as long as the instantiator stays - around. The instantiator is stored in the `image' slot of the - glyph, so as long as the glyph is marked the instantiator will be - as well and hence the cached image instance also.*/ - Fputhash (XCAR (XCDR (locative)), XCAR (locative), XCDR (XCDR (locative))); - free_cons (XCDR (locative)); - free_cons (locative); - return Qnil; -} + if (SPECIFIERP (specifier)) + glyph = IMAGE_SPECIFIER_ATTACHEE (XIMAGE_SPECIFIER (specifier)); -/* Given a specification for an image, return an instance of - the image which matches the given instantiator and which can be - displayed in the given domain. */ + if (!WINDOW_LIVE_P (XWINDOW (window)) || !marked_p (window)) + return 0; -static Lisp_Object -image_instantiate (Lisp_Object specifier, Lisp_Object UNUSED (matchspec), - Lisp_Object domain, Lisp_Object instantiator, - Lisp_Object depth) -{ - Lisp_Object glyph = IMAGE_SPECIFIER_ATTACHEE (XIMAGE_SPECIFIER (specifier)); - int dest_mask = XIMAGE_SPECIFIER_ALLOWED (specifier); - int pointerp = dest_mask & image_instance_type_to_mask (IMAGE_POINTER); + if (!marked_p (specifier) && !marked_p (e->value)) + return 0; - if (IMAGE_INSTANCEP (instantiator)) + if (!marked_p (matchspec)) + return 0; + + if (GLYPHP (glyph)) { - /* make sure that the image instance's governing domain and type are - matching. */ - Lisp_Object governing_domain = XIMAGE_INSTANCE_DOMAIN (instantiator); - - if ((DEVICEP (governing_domain) - && EQ (governing_domain, DOMAIN_DEVICE (domain))) - || (FRAMEP (governing_domain) - && EQ (governing_domain, DOMAIN_FRAME (domain))) - || (WINDOWP (governing_domain) - && EQ (governing_domain, DOMAIN_WINDOW (domain)))) + if (EXTENTP (matchspec)) { - int mask = - image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instantiator)); - if (mask & dest_mask) - return instantiator; - else - invalid_argument ("Type of image instance not allowed here", - instantiator); + EXTENT ex = XEXTENT (matchspec); + + if (!EXTENT_LIVE_P (ex)) + return 0; + if (!EQ (glyph, !NILP (end_glyph_p) ? extent_end_glyph (ex) : + extent_begin_glyph (ex))) + return 0; } - else - invalid_argument_2 ("Wrong domain for image instance", - instantiator, domain); - } - /* How ugly !! An image instanciator that uses a kludgy syntax to snarf in - face properties. There's a design flaw here. -- didier */ - else if (VECTORP (instantiator) - && EQ (INSTANTIATOR_TYPE (instantiator), Qinherit)) - { - assert (XVECTOR_LENGTH (instantiator) == 3); - return (FACE_PROPERTY_INSTANCE + else if (TOOLBAR_BUTTONP (matchspec)) + { + struct toolbar_button *tb = XTOOLBAR_BUTTON (matchspec); + if (GLYPHP (glyph)) + { + if (!EQ (glyph, tb->up_glyph) && + !EQ (glyph, tb->down_glyph) && + !EQ (glyph, tb->disabled_glyph) && + !EQ (glyph, tb->cap_up_glyph) && + !EQ (glyph, tb->cap_down_glyph) && + !EQ (glyph, tb->cap_disabled_glyph)) + return 0; + } + } + else if (IMAGE_INSTANCEP (matchspec)) + { + Lisp_Object iglyph = + find_keyword_in_vector (XIMAGE_INSTANCE_INSTANTIATOR (matchspec), + Q_image); + if (!EQ (glyph, iglyph)) + return 0; + } + else if (CONSP (matchspec)) + { + if (!NILP (end_glyph_p) ? !EQ (glyph, XCDR (matchspec)) + : !EQ (glyph, XCAR (matchspec))) + return 0; + } + } + + return mark_object_if_not (e->key) + mark_object_if_not (e->value); +} + +Lisp_Object +make_image_instance_device_cache (void) +{ + return make_general_lisp_hash_table + (image_instance_cache_key_eq_hash, image_instance_cache_key_eq_equal, + 30, -1.0, -1.0, + image_instance_device_cache_weak); +} + +Lisp_Object +make_image_instance_frame_cache (void) +{ + return make_general_lisp_hash_table + (image_instance_cache_key_eq_hash, image_instance_cache_key_eq_equal, + 30, -1.0, -1.0, + image_instance_frame_cache_weak); +} + +static Lisp_Object +image_instantiate_cache_result (Lisp_Object locative) +{ + /* locative = (value key . table) */ + Fputhash (XCAR (XCDR (locative)), XCAR (locative), XCDR (XCDR (locative))); + free_cons (XCDR (locative)); + free_cons (locative); + return Qnil; +} + +/* Given a specification for an image, return an instance of + the image which matches the given instantiator and which can be + displayed in the given domain. See comment at top of file concerning + the caches we use. */ + +static Lisp_Object +image_instantiate (Lisp_Object specifier, Lisp_Object matchspec, + Lisp_Object domain, Lisp_Object instantiator, + Lisp_Object depth) +{ + /* "glyph" should be in quotes because it may not be a glyph; for + background pixmap specifiers, it will be a face, and for user-created + specifiers, it will be nil. */ + Lisp_Object glyph = IMAGE_SPECIFIER_ATTACHEE (XIMAGE_SPECIFIER (specifier)); + int dest_mask = XIMAGE_SPECIFIER_ALLOWED (specifier); + int pointerp = dest_mask & image_instance_type_to_mask (IMAGE_POINTER); + + /* If an image instance is passed in, just extract its instantiator. + We used to try to use the instance itself, but that leads to excessive + complexity -- e.g. it may mess up our caching scheme. */ + if (IMAGE_INSTANCEP (instantiator)) + instantiator = XIMAGE_INSTANCE_INSTANTIATOR (instantiator); + + /* #### How ugly !! An image instantiator that uses a kludgy syntax to + #### snarf in face properties. There's a design flaw here. -- + #### didier */ + if (VECTORP (instantiator) + && EQ (INSTANTIATOR_TYPE (instantiator), Qinherit)) + { + assert (XVECTOR_LENGTH (instantiator) == 3); + return (FACE_PROPERTY_INSTANCE (Fget_face (XVECTOR_DATA (instantiator)[2]), Qbackground_pixmap, domain, 1, depth)); } else { - Lisp_Object instance = Qnil; - Lisp_Object subtable = Qnil; - /* #### Should this be GCPRO'd? */ - Lisp_Object hash_key = Qnil; + Lisp_Object instance = Qnil, hash_key, table; Lisp_Object pointer_fg = Qnil; Lisp_Object pointer_bg = Qnil; Lisp_Object governing_domain = ＠＠ -3276,142 +4716,142 ＠＠ /* We have to put subwindow, widget and text image instances in a per-window cache so that we can see the same glyph in - different windows. We use governing_domain to determine the type - of image_instance that will be created. */ + different windows. We use governing_domain to determine the type + of image_instance that will be created. (#### I think it's bogus + that text instances have a per-window governing domain. See + comment at top of file.) + */ if (pointerp) { + if (!DEVICEP (governing_domain)) + gui_error ("Subcontrols can't be used as pointers", instantiator); + pointer_fg = FACE_FOREGROUND (Vpointer_face, domain); pointer_bg = FACE_BACKGROUND (Vpointer_face, domain); - hash_key = list4 (glyph, INSTANTIATOR_TYPE (instantiator), + hash_key = list4 (specifier, INSTANTIATOR_TYPE (instantiator), pointer_fg, pointer_bg); } - else + else if (DEVICEP (governing_domain)) /* We cannot simply key on the glyph since fallbacks could use the same glyph but have a totally different instantiator - type. Thus we key on the glyph and the type (but not any - other parts of the instantiator. */ - hash_key = list2 (glyph, INSTANTIATOR_TYPE (instantiator)); + format. Thus we key on the glyph and the type (but not any + other parts) of the instantiator. - /* First look in the device cache. */ - if (DEVICEP (governing_domain)) + #### It is somewhat bogus that we're keying on both the + #### instantiator format and the dest mask (which relates to the + #### instance type). */ + hash_key = list3 (specifier, INSTANTIATOR_TYPE (instantiator), + make_int (dest_mask)); + else { - subtable = Fgethash (make_int (dest_mask), - XDEVICE (governing_domain)-> - image_instance_cache, - Qunbound); - if (UNBOUNDP (subtable)) + /* For subcontrols, we store them in a frame cache rather than a + window cache, since most redisplay routines want to be able to + iterate over all subcontrols in a frame. Thus, we record the + governing domain (a window) in the hash key. We also + use the MATCHSPEC, which may be an extent, so we can handle two + subcontrols on a single window. See the top-of-file comment + under governing domains. */ + int end_p = 0; + + if (UNBOUNDP (matchspec)) { - /* For the image instance cache, we do comparisons with - EQ rather than with EQUAL, as we do for color and - font names. The reasons are: - - 1) pixmap data can be very long, and thus the hashing - and comparing will take awhile. - - 2) It's not so likely that we'll run into things that - are EQUAL but not EQ (that can happen a lot with - faces, because their specifiers are copied around); - but pixmaps tend not to be in faces. - - However, if the image-instance could be a pointer, we - have to use EQUAL because we massaged the - instantiator into a cons3 also containing the - foreground and background of the pointer face. */ - subtable = make_image_instance_cache_hash_table (); - - Fputhash (make_int (dest_mask), subtable, - XDEVICE (governing_domain)->image_instance_cache); - instance = Qunbound; + Lisp_Object type = INSTANTIATOR_TYPE (instantiator); + /* #### major hack, get rid of */ + if (!EQ (type, Qstring) && !EQ (type, Qformatted_string)) + gui_error ("Subcontrols can't be used for built-in glyphs or display tables", + instantiator); } - else + if (EXTENTP (matchspec)) + { + if (EQ (glyph, extent_begin_glyph (XEXTENT (matchspec)))) + end_p = 0; + else if (EQ (glyph, extent_end_glyph (XEXTENT (matchspec)))) + end_p = 1; + else + /* Huh? We were passed an extent that doesn't match the + glyph. (This might happen, since the user can pass in + any matchspec they want.) */ + matchspec = Qnil; + } + if (CONSP (matchspec)) { - instance = Fgethash (hash_key, subtable, Qunbound); + if (EQ (glyph, XCAR (matchspec))) + end_p = 0; + else if (EQ (glyph, XCDR (matchspec))) + end_p = 1; + else + matchspec = Qnil; } + + hash_key = list5 (specifier, governing_domain, + matchspec, end_p ? Qt : Qnil, + INSTANTIATOR_TYPE (instantiator)); } + + if (DEVICEP (governing_domain)) + table = XDEVICE (governing_domain)->image_instance_cache; else if (WINDOWP (governing_domain)) + table = XWINDOW_XFRAME (governing_domain)->subcontrol_instance_cache; + else { - /* Subwindows have a per-window cache and have to be treated - differently. */ - instance = - Fgethash (hash_key, - XWINDOW (governing_domain)->subwindow_instance_cache, - Qunbound); + ABORT (); /* We're not allowed anything else currently. */ + table = Qnil; } - else - ABORT (); /* We're not allowed anything else currently. */ - /* If we don't have an instance at this point then create - one. */ - if (UNBOUNDP (instance)) + /* Old comment: + + [[ For the image instance cache, we do comparisons with + EQ rather than with EQUAL, as we do for color and + font names. The reasons are: + + 1) pixmap data can be very long, and thus the hashing + and comparing will take awhile. + + 2) It's not so likely that we'll run into things that + are EQUAL but not EQ (that can happen a lot with + faces, because their specifiers are copied around); + but pixmaps tend not to be in faces. + ]] + + but we don't store the instantiators any more in the cache key; + we key off the glyph itself. */ + instance = Fgethash (hash_key, table, Qunbound); + + /* If we don't have an instance at this point, or if we failed to + instantiate last time but the instantiator has been changed, then + create one. */ + if (UNBOUNDP (instance) || + (!IMAGE_INSTANCEP (instance) && !EQ (instance, instantiator))) { Lisp_Object locative = - noseeum_cons (Qnil, - noseeum_cons (hash_key, - DEVICEP (governing_domain) ? subtable - : XWINDOW (governing_domain) - ->subwindow_instance_cache)); + noseeum_cons (instantiator, noseeum_cons (hash_key, table)); int speccount = specpdl_depth (); - /* Make sure we cache the failures, too. Use an - unwind-protect to catch such errors. If we fail, the - unwind-protect records nil in the hash table. If we - succeed, we change the car of the locative to the - resulting instance, which gets recorded instead. */ - record_unwind_protect (image_instantiate_cache_result, - locative); + /* Make sure we cache the failures, too. Use an unwind-protect + to catch such errors. If we fail, the unwind-protect records + the instantiator in the hash table. If we succeed, we change + the car of the locative to the resulting instance, which gets + recorded instead. */ + record_unwind_protect (image_instantiate_cache_result, locative); instance = instantiate_image_instantiator (governing_domain, domain, instantiator, pointer_fg, pointer_bg, - dest_mask, glyph); - - /* We need a per-frame cache for redisplay. */ - cache_subwindow_instance_in_frame_maybe (instance); - + dest_mask, glyph, Qnil); Fsetcar (locative, instance); -#ifdef ERROR_CHECK_GLYPHS - if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance)) - & (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK)) - assert (EQ (XIMAGE_INSTANCE_FRAME (instance), - DOMAIN_FRAME (domain))); -#endif unbind_to (speccount); -#ifdef ERROR_CHECK_GLYPHS - if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance)) - & (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK)) - assert (EQ (Fgethash (hash_key, - XWINDOW (governing_domain) - ->subwindow_instance_cache, - Qunbound), instance)); -#endif } - else if (NILP (instance)) - gui_error ("Can't instantiate image (probably cached)", instantiator); - /* We found an instance. However, because we are using the glyph - as the hash key instead of the instantiator, the current - instantiator may not be the same as the original. Thus we - must update the instance based on the new - instantiator. Preserving instance identity like this is - important to stop excessive window system widget creation and - deletion - and hence flashing. */ + else if (!IMAGE_INSTANCEP (instance)) + gui_error ("Can't instantiate image (cached)", instantiator); else - { - /* #### This function should be able to cope with *all* - changes to the instantiator, but currently only copes - with the most used properties. This means that it is - possible to make changes that don't get reflected in the - display. */ - update_image_instance (instance, instantiator); - free_list (hash_key); - } + /* We found an instance. However, the instantiator might have + changed. Thus we must update the instance based on the new + instantiator. */ + update_image_instance (instance, instantiator, domain); -#ifdef ERROR_CHECK_GLYPHS - if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance)) - & (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK)) - assert (EQ (XIMAGE_INSTANCE_FRAME (instance), - DOMAIN_FRAME (domain))); -#endif + glyph_checking_assert (EQ (XIMAGE_INSTANCE_DOMAIN (instance), + governing_domain)); ERROR_CHECK_IMAGE_INSTANCE (instance); RETURN_UNGCPRO (instance); } ＠＠ -3631,7 +5071,7 ＠＠ DEFUN ("image-specifier-p", Fimage_specifier_p, 1, 1, 0, /* Return non-nil if OBJECT is an image specifier. -See `make-image-specifier' for a description of image instantiators. +See `make-glyph' for a description of image instantiators. */ (object)) { ＠＠ -3675,7 +5115,7 ＠＠ be eq. This isn't concerned with "unspecified" attributes, that's what - #'glyph-differs-from-default-p is for. */ + `glyph-differs-from-default-p' is for. */ static int glyph_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) { ＠＠ -3793,7 +5233,7 ＠＠ g->type = type; g->image = Fmake_specifier (Qimage); /* This function can GC */ - g->dirty = 0; + GLYPH_DIRTYP (g) = 0; switch (g->type) { case GLYPH_BUFFER: ＠＠ -3897,7 +5337,7 ＠＠ `buffer' glyphs can be used as the begin-glyph or end-glyph of an extent, in the modeline, and in the toolbar. Their image can be instantiated as `nothing', `mono-pixmap', `color-pixmap', `text', -and `subwindow'. +`subwindow' and `widget'. `pointer' glyphs can be used to specify the mouse pointer. Their image can be instantiated as `pointer'. ＠＠ -3909,19 +5349,18 ＠＠ (type)) { enum glyph_type typeval = decode_glyph_type (type, ERROR_ME); - return allocate_glyph (typeval, 0); + return allocate_glyph (typeval, redisplay_glyph_changed); } DEFUN ("glyphp", Fglyphp, 1, 1, 0, /* Return non-nil if OBJECT is a glyph. -A glyph is an object used for pixmaps, widgets and the like. It is used -in begin-glyphs and end-glyphs attached to extents, in marginal and textual +A glyph is an object used for pixmaps, widgets and the like. It is used in +begin-glyphs and end-glyphs attached to extents, in marginal and textual annotations, in overlay arrows (overlay-arrow-* variables), in toolbar -buttons, and the like. Much more detailed information can be found at -`make-glyph'. Its image is described using an image specifier -- -see `make-image-specifier'. See also `make-image-instance' for further -information. +buttons, and the like. Its image is described using an image specifier. +Much more detailed information can be found at `make-glyph'; see also +`make-image-instance'. */ (object)) { ＠＠ -3930,7 +5369,7 ＠＠ DEFUN ("glyph-type", Fglyph_type, 1, 1, 0, /* Return the type of the given glyph. -The return value will be one of 'buffer, 'pointer, or 'icon. +The return value will be one of `buffer', `pointer', or `icon'. */ (glyph)) { ＠＠ -3944,15 +5383,21 ＠＠ } } +/* MATCHSPEC is an object that's used to uniquely identify a particular + displayed subcontrol. The idea is that we want to avoid trying to + display two subcontrols in different places in the same window, since + that will cause infinite flashing. See top-of-file comment under + governing domains. */ + Lisp_Object glyph_image_instance (Lisp_Object glyph, Lisp_Object domain, - Error_Behavior errb, int no_quit) + Lisp_Object matchspec, Error_Behavior errb, int no_quit) { Lisp_Object specifier = GLYPH_IMAGE (XGLYPH (glyph)); - /* This can never return Qunbound. All glyphs have 'nothing as + /* This can never return Qunbound. All glyphs have `nothing' as a fallback. */ - Lisp_Object image_instance = specifier_instance (specifier, Qunbound, + Lisp_Object image_instance = specifier_instance (specifier, matchspec, domain, errb, no_quit, 0, Qzero); assert (!UNBOUNDP (image_instance)); ＠＠ -3962,12 +5407,13 ＠＠ } static Lisp_Object -glyph_image_instance_maybe (Lisp_Object glyph_or_image, Lisp_Object window) +glyph_image_instance_maybe (Lisp_Object glyph_or_image, Lisp_Object window, + Lisp_Object matchspec) { Lisp_Object instance = glyph_or_image; if (GLYPHP (glyph_or_image)) - instance = glyph_image_instance (glyph_or_image, window, + instance = glyph_image_instance (glyph_or_image, window, matchspec, ERROR_ME_DEBUG_WARN, 1); return instance; ＠＠ -3997,10 +5443,11 ＠＠ the associated image instances. ****************************************************************************/ unsigned short -glyph_width (Lisp_Object glyph_or_image, Lisp_Object domain) +glyph_width (Lisp_Object glyph_or_image, Lisp_Object domain, + Lisp_Object matchspec) { Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image, - domain); + domain, matchspec); if (!IMAGE_INSTANCEP (instance)) return 0; ＠＠ -4023,14 +5470,15 ＠＠ window = wrap_window (decode_window (window)); CHECK_GLYPH (glyph); - return make_int (glyph_width (glyph, window)); + return make_int (glyph_width (glyph, window, Qnil)); } unsigned short -glyph_ascent (Lisp_Object glyph_or_image, Lisp_Object domain) +glyph_ascent (Lisp_Object glyph_or_image, Lisp_Object domain, + Lisp_Object matchspec) { Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image, - domain); + domain, matchspec); if (!IMAGE_INSTANCEP (instance)) return 0; ＠＠ -4047,10 +5495,11 ＠＠ } unsigned short -glyph_descent (Lisp_Object glyph_or_image, Lisp_Object domain) +glyph_descent (Lisp_Object glyph_or_image, Lisp_Object domain, + Lisp_Object matchspec) { Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image, - domain); + domain, matchspec); if (!IMAGE_INSTANCEP (instance)) return 0; ＠＠ -4068,10 +5517,11 ＠＠ /* strictly a convenience function. */ unsigned short -glyph_height (Lisp_Object glyph_or_image, Lisp_Object domain) +glyph_height (Lisp_Object glyph_or_image, Lisp_Object domain, + Lisp_Object matchspec) { Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image, - domain); + domain, matchspec); if (!IMAGE_INSTANCEP (instance)) return 0; ＠＠ -4095,7 +5545,7 ＠＠ window = wrap_window (decode_window (window)); CHECK_GLYPH (glyph); - return make_int (glyph_ascent (glyph, window)); + return make_int (glyph_ascent (glyph, window, Qnil)); } DEFUN ("glyph-descent", Fglyph_descent, 1, 2, 0, /* ＠＠ -4108,7 +5558,7 ＠＠ window = wrap_window (decode_window (window)); CHECK_GLYPH (glyph); - return make_int (glyph_descent (glyph, window)); + return make_int (glyph_descent (glyph, window, Qnil)); } /* This is redundant but I bet a lot of people expect it to exist. */ ＠＠ -4122,46 +5572,31 ＠＠ window = wrap_window (decode_window (window)); CHECK_GLYPH (glyph); - return make_int (glyph_height (glyph, window)); + return make_int (glyph_height (glyph, window, Qnil)); } static void -set_glyph_dirty_p (Lisp_Object glyph_or_image, Lisp_Object window, int dirty) +set_image_instance_dirty_p (Lisp_Object instance, int dirty) { - Lisp_Object instance = glyph_or_image; - - if (!NILP (glyph_or_image)) + Lisp_Object parent = XIMAGE_INSTANCE_PARENT (instance); + XIMAGE_INSTANCE_DIRTYP (instance) = dirty; + if (IMAGE_INSTANCEP (parent)) + /* Now cascade up the hierarchy. */ + set_image_instance_dirty_p (XIMAGE_INSTANCE_PARENT (instance), dirty); + else if (GLYPHP (parent)) { - if (GLYPHP (glyph_or_image)) + XGLYPH_DIRTYP (parent) = dirty; + if (dirty) { - instance = glyph_image_instance (glyph_or_image, window, - ERROR_ME_DEBUG_WARN, 1); - XGLYPH_DIRTYP (glyph_or_image) = dirty; + Lisp_Object govdom = XIMAGE_INSTANCE_DOMAIN (instance); + if (DEVICEP (govdom)) + MARK_DEVICE_FRAMES_GLYPHS_CHANGED (XDEVICE (govdom)); + else /* must be window */ + MARK_FRAME_GLYPHS_CHANGED (XWINDOW_XFRAME (govdom)); } - - if (!IMAGE_INSTANCEP (instance)) - return; - - XIMAGE_INSTANCE_DIRTYP (instance) = dirty; } } -static void -set_image_instance_dirty_p (Lisp_Object instance, int dirty) -{ - if (IMAGE_INSTANCEP (instance)) - { - XIMAGE_INSTANCE_DIRTYP (instance) = dirty; - /* Now cascade up the hierarchy. */ - set_image_instance_dirty_p (XIMAGE_INSTANCE_PARENT (instance), - dirty); - } - else if (GLYPHP (instance)) - { - XGLYPH_DIRTYP (instance) = dirty; - } -} - /* #### do we need to cache this info to speed things up? */ Lisp_Object ＠＠ -4216,48 +5651,13 ＠＠ (XGLYPH (glyph)->after_change) (glyph, property, locale); } -void -glyph_query_geometry (Lisp_Object glyph_or_image, int* width, int* height, - enum image_instance_geometry disp, Lisp_Object domain) -{ - Lisp_Object instance = glyph_or_image; - - if (GLYPHP (glyph_or_image)) - instance = glyph_image_instance (glyph_or_image, domain, - ERROR_ME_DEBUG_WARN, 1); - - image_instance_query_geometry (instance, width, height, disp, domain); -} - -void -glyph_do_layout (Lisp_Object glyph_or_image, int width, int height, - int xoffset, int yoffset, Lisp_Object domain) -{ - Lisp_Object instance = glyph_or_image; - - if (GLYPHP (glyph_or_image)) - instance = glyph_image_instance (glyph_or_image, domain, - ERROR_ME_DEBUG_WARN, 1); - - image_instance_layout (instance, width, height, xoffset, yoffset, domain); -} -  -/***************************************************************************** - * glyph cachel functions * - *****************************************************************************/ +/****************************************************************** + * glyph cachel functions * + ******************************************************************/ -/* #### All of this is 95% copied from face cachels. Consider - consolidating. +/* See comment at top of file. */ - Why do we need glyph_cachels? Simply because a glyph_cachel captures - per-window information about a particular glyph. A glyph itself is - not created in any particular context, so if we were to rely on a - glyph to tell us about its dirtiness we would not be able to reset - the dirty flag after redisplaying it as it may exist in other - contexts. When we have redisplayed we need to know which glyphs to - reset the dirty flags on - the glyph_cachels give us a nice list we - can iterate through doing this. */ void mark_glyph_cachels (glyph_cachel_dynarr *elements) { ＠＠ -4270,6 +5670,7 ＠＠ { struct glyph_cachel *cachel = Dynarr_atp (elements, elt); mark_object (cachel->glyph); + mark_object (cachel->matchspec); } } ＠＠ -4279,7 +5680,7 ＠＠ { if (!cachel->updated || NILP (cachel->glyph) || !EQ (cachel->glyph, glyph) || XGLYPH_DIRTYP (cachel->glyph) - || XFRAME(WINDOW_FRAME(w))->faces_changed) + || XFRAME (WINDOW_FRAME (w))->faces_changed) { Lisp_Object window, instance; ＠＠ -4288,73 +5689,69 ＠＠ cachel->glyph = glyph; /* Speed things up slightly by grabbing the glyph instantiation and passing it to the size functions. */ - instance = glyph_image_instance (glyph, window, ERROR_ME_DEBUG_WARN, 1); + instance = glyph_image_instance (glyph, window, cachel->matchspec, + ERROR_ME_DEBUG_WARN, 1); if (!IMAGE_INSTANCEP (instance)) return; /* Mark text instance of the glyph dirty if faces have changed, because its geometry might have changed. */ - invalidate_glyph_geometry_maybe (instance, w); + invalidate_glyph_geometry_maybe (instance, w, cachel->matchspec); - /* #### Do the following 2 lines buy us anything? --kkm */ - XGLYPH_DIRTYP (glyph) = XIMAGE_INSTANCE_DIRTYP (instance); - cachel->dirty = XGLYPH_DIRTYP (glyph); - cachel->width = glyph_width (instance, window); - cachel->ascent = glyph_ascent (instance, window); - cachel->descent = glyph_descent (instance, window); + cachel->width = glyph_width (instance, window, cachel->matchspec); + cachel->ascent = glyph_ascent (instance, window, cachel->matchspec); + cachel->descent = glyph_descent (instance, window, cachel->matchspec); } cachel->updated = 1; } static void -add_glyph_cachel (struct window *w, Lisp_Object glyph) +add_glyph_cachel (struct window *w, Lisp_Object glyph, Lisp_Object matchspec) { struct glyph_cachel new_cachel; xzero (new_cachel); new_cachel.glyph = Qnil; - + new_cachel.matchspec = matchspec; update_glyph_cachel_data (w, glyph, &new_cachel); Dynarr_add (w->glyph_cachels, new_cachel); } -glyph_index -get_glyph_cachel_index (struct window *w, Lisp_Object glyph) +void +record_glyph_cachel (struct window *w, Lisp_Object glyph, + Lisp_Object matchspec) { int elt; - if (noninteractive) - return 0; - for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++) { struct glyph_cachel *cachel = Dynarr_atp (w->glyph_cachels, elt); - if (EQ (cachel->glyph, glyph) && !NILP (glyph)) + if (EQ (cachel->glyph, glyph) && EQ (cachel->matchspec, matchspec) + && !NILP (glyph)) { update_glyph_cachel_data (w, glyph, cachel); - return elt; + return; } } /* If we didn't find the glyph, add it and then return its index. */ - add_glyph_cachel (w, glyph); - return elt; + add_glyph_cachel (w, glyph, matchspec); } void reset_glyph_cachels (struct window *w) { Dynarr_reset (w->glyph_cachels); - get_glyph_cachel_index (w, Vcontinuation_glyph); - get_glyph_cachel_index (w, Vtruncation_glyph); - get_glyph_cachel_index (w, Vhscroll_glyph); - get_glyph_cachel_index (w, Vcontrol_arrow_glyph); - get_glyph_cachel_index (w, Voctal_escape_glyph); - get_glyph_cachel_index (w, Vinvisible_text_glyph); + record_glyph_cachel (w, Vcontinuation_glyph, Qunbound); + record_glyph_cachel (w, Vtruncation_glyph, Qunbound); + record_glyph_cachel (w, Vhscroll_glyph, Qunbound); + record_glyph_cachel (w, Vcontrol_arrow_glyph, Qunbound); + record_glyph_cachel (w, Voctal_escape_glyph, Qunbound); + record_glyph_cachel (w, Vinvisible_text_glyph, Qunbound); } void ＠＠ -4383,9 +5780,9 ＠＠ } } -/* Unset the dirty bit on all the glyph cachels that have it. */ +/* Unset the dirty bit on all the glyphs in the cachel list. */ void -mark_glyph_cachels_as_clean (struct window* w) +mark_glyph_cachels_as_clean (struct window *w) { int elt; Lisp_Object window = wrap_window (w); ＠＠ -4393,8 +5790,16 ＠＠ for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++) { struct glyph_cachel *cachel = Dynarr_atp (w->glyph_cachels, elt); - cachel->dirty = 0; - set_glyph_dirty_p (cachel->glyph, window, 0); + Lisp_Object instance = Qnil; + + if (!NILP (cachel->glyph)) + instance = glyph_image_instance (cachel->glyph, window, + cachel->matchspec, + ERROR_ME_DEBUG_WARN, 1); + XGLYPH_DIRTYP (cachel->glyph) = 0; + + if (IMAGE_INSTANCEP (instance)) + XIMAGE_INSTANCE_DIRTYP (instance) = 0; } } ＠＠ -4416,230 +5821,213 ＠＠  -/***************************************************************************** - * subwindow cachel functions * - *****************************************************************************/ -/* Subwindows are curious in that you have to physically unmap them to - not display them. It is problematic deciding what to do in - redisplay. We have two caches - a per-window instance cache that - keeps track of subwindows on a window, these are linked to their - instantiator in the hashtable and when the instantiator goes away - we want the instance to go away also. However we also have a - per-frame instance cache that we use to determine if a subwindow is - obscuring an area that we want to clear. We need to be able to flip - through this quickly so a hashtable is not suitable hence the - subwindow_cachels. This is a weak list so unreference instances - will get deleted properly. */ +/********************************************************************** + * subcontrol cache functions * + **********************************************************************/ -/* redisplay in general assumes that drawing something will erase - what was there before. unfortunately this does not apply to - subwindows that need to be specifically unmapped in order to - disappear. we take a brute force approach - on the basis that its - cheap - and unmap all subwindows in a display line */ +/* See comment at top of file about these caches. */ -/* Put new instances in the frame subwindow cache. This is less costly than - doing it every time something gets mapped, and deleted instances will be - removed automatically. */ -static void -cache_subwindow_instance_in_frame_maybe (Lisp_Object instance) +/* Map MAPFUN over all subcontrols in the subcontrol cache in frame F. + MAPFUN is called with each key and value in the cache, as well as + the value of CLOSURE that was passed in. It should return 0 to continue + mapping, or non-zero to stop. + + NOTE: The function needs to check if VALUE is an image instance, since + the cache also includes failures. Furthermore, there (currently) may + be text image instances as well as subcontrol image instances. + #### Fix this! */ + +static int +map_over_subcontrols (struct frame *f, int (*mapfun) (Lisp_Object key, + Lisp_Object value, + void *closure), + void *closure) { - Lisp_Image_Instance* ii = XIMAGE_INSTANCE (instance); - if (!NILP (DOMAIN_FRAME (IMAGE_INSTANCE_DOMAIN (ii)))) - { - struct frame* f = DOMAIN_XFRAME (IMAGE_INSTANCE_DOMAIN (ii)); - XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f)) - = Fcons (instance, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f))); - } + return elisp_maphash_unsafe (mapfun, f->subcontrol_instance_cache, + closure); } -/* Unmap and finalize all subwindow instances in the frame cache. This - is necessary because GC will not guarantee the order things get - deleted in and moreover, frame finalization deletes the window - system windows before deleting XEmacs windows, and hence - subwindows. */ -int -unmap_subwindow_instance_cache_mapper (Lisp_Object UNUSED (key), - Lisp_Object value, void* finalize) +static int +free_window_subcontrols_mapper (Lisp_Object key, Lisp_Object value, + void *closure) { - /* value can be nil; we cache failures as well as successes */ - if (!NILP (value)) + /* we cache failures as well as successes */ + if (IMAGE_INSTANCEP (value) && EQ (XIMAGE_INSTANCE_DOMAIN (value), + VOID_TO_LISP (closure))) { - struct frame* f = XFRAME (XIMAGE_INSTANCE_FRAME (value)); - unmap_subwindow (value); - if (finalize) - { - /* In case GC doesn't catch up fast enough, remove from the frame - cache also. Otherwise code that checks the sanity of the instance - will fail. */ - XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f)) - = delq_no_quit (value, - XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f))); - finalize_image_instance (XIMAGE_INSTANCE (value), 0); - } + unmap_subcontrol (value); + finalize_image_instance (XIMAGE_INSTANCE (value), 0); + return 1; } return 0; } -static void -finalize_all_subwindow_instances (struct window *w) +/* Unmap, finalize and remove from the cache all subcontrol instances on + window W. */ + +void +free_window_subcontrols (struct window *w) { - if (!NILP (w->next)) finalize_all_subwindow_instances (XWINDOW (w->next)); - if (!NILP (w->vchild)) finalize_all_subwindow_instances (XWINDOW (w->vchild)); - if (!NILP (w->hchild)) finalize_all_subwindow_instances (XWINDOW (w->hchild)); + elisp_map_remhash (free_window_subcontrols_mapper, + WINDOW_XFRAME (w)->subcontrol_instance_cache, + LISP_TO_VOID (wrap_window (w))); +} - elisp_maphash (unmap_subwindow_instance_cache_mapper, - w->subwindow_instance_cache, (void*)1); +static int +free_frame_subcontrols_mapper (Lisp_Object UNUSED (key), Lisp_Object value, + void *closure) +{ + /* we cache failures as well as successes */ + if (IMAGE_INSTANCEP (value)) + { + unmap_subcontrol (value); + finalize_image_instance (XIMAGE_INSTANCE (value), 0); + } + return 0; } +/* Unmap and finalize all subcontrol instances in the frame cache, and + clear the cache. This is necessary because deleting the frame deletes + its window system window and hence all subwindows, and we don't want the + finalizers to have to deal with this possibility. */ + void -free_frame_subwindow_instances (struct frame* f) +free_frame_subcontrols (struct frame *f) { - /* Make sure all instances are finalized. We have to do this via the - instance cache since some instances may be extant but not - displayed (and hence not in the frame cache). */ - finalize_all_subwindow_instances (XWINDOW (f->root_window)); + map_over_subcontrols (f, free_frame_subcontrols_mapper, NULL); + Fclrhash (f->subcontrol_instance_cache); } +static int +unmap_subcontrol_mapper (Lisp_Object key, Lisp_Object value, void *closure) +{ + if (IMAGE_INSTANCEP (value)) + unmap_subcontrol (value); + return 0; +} + /* Unmap all instances in the frame cache. */ void -reset_frame_subwindow_instance_cache (struct frame* f) +frame_unmap_all_subcontrols (struct frame *f) { - Lisp_Object rest; - - LIST_LOOP (rest, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f))) - { - Lisp_Object value = XCAR (rest); - unmap_subwindow (value); - } + map_over_subcontrols (f, unmap_subcontrol_mapper, NULL); } -/***************************************************************************** - * subwindow exposure ignorance * - *****************************************************************************/ -/* when we unmap subwindows the associated window system will generate - expose events. This we do not want as redisplay already copes with - the repainting necessary. Worse, we can get in an endless cycle of - redisplay if we are not careful. Thus we keep a per-frame list of - expose events that are going to come and ignore them as - required. */ + +/**************************************************************************** + * subcontrol functions * + ****************************************************************************/ -struct expose_ignore_blocktype +struct rusarg { - Blocktype_declare (struct expose_ignore); -} *the_expose_ignore_blocktype; + int x; + int y; + int width; + int height; + Lisp_Object ignored_subcontrol; +}; -int -check_for_ignored_expose (struct frame* f, int x, int y, int width, int height) +static int +redisplay_unmap_subcontrols_mapper (Lisp_Object key, Lisp_Object value, + void *closure) { - struct expose_ignore *ei, *prev; - /* the ignore list is FIFO so we should generally get a match with - the first element in the list */ - for (ei = f->subwindow_exposures, prev = 0; ei; ei = ei->next) - { - /* Checking for exact matches just isn't good enough as we - might get exposures for partially obscured subwindows, thus - we have to check for overlaps. Being conservative, we will - check for exposures wholly contained by the subwindow - this - might give us what we want.*/ - if (ei->x <= x && ei->y <= y - && ei->x + ei->width >= x + width - && ei->y + ei->height >= y + height) - { -#ifdef DEBUG_WIDGETS - stderr_out ("ignored %d+%d, %dx%d for exposure %d+%d, %dx%d\n", - x, y, width, height, ei->x, ei->y, ei->width, ei->height); -#endif - if (!prev) - f->subwindow_exposures = ei->next; - else - prev->next = ei->next; - - if (ei == f->subwindow_exposures_tail) - f->subwindow_exposures_tail = prev; + Lisp_Image_Instance *ii; + struct rusarg *arg = (struct rusarg *) closure; - Blocktype_free (the_expose_ignore_blocktype, ei); - return 1; - } - prev = ei; - } + if (!IMAGE_INSTANCEP (value)) + return 0; + ii = XIMAGE_INSTANCE (value); + if (IMAGE_INSTANCE_SUBCONTROL_DISPLAYEDP (ii) + && IMAGE_INSTANCE_DISPLAY_X (ii) + IMAGE_INSTANCE_DISPLAY_WIDTH (ii) > + arg->x + && IMAGE_INSTANCE_DISPLAY_X (ii) < arg->x + arg->width + && IMAGE_INSTANCE_DISPLAY_Y (ii) + IMAGE_INSTANCE_DISPLAY_HEIGHT (ii) > + arg->y + && IMAGE_INSTANCE_DISPLAY_Y (ii) < arg->y + arg->height + && !EQ (value, arg->ignored_subcontrol)) + unmap_subcontrol (value); return 0; } -static void -register_ignored_expose (struct frame* f, int x, int y, int width, int height) +/**************************************************************************** + redisplay_unmap_subcontrols + + Remove subcontrols from the area in the box defined by the given + parameters. If IGNORED_SUBCONTROL is non-nil, do not remove it. + ****************************************************************************/ +void +redisplay_unmap_subcontrols (struct frame *f, int x, int y, int width, + int height, Lisp_Object ignored_subcontrol) { - if (!hold_ignored_expose_registration) - { - struct expose_ignore *ei; + struct rusarg arg; - ei = Blocktype_alloc (the_expose_ignore_blocktype); + arg.x = x; + arg.y = y; + arg.width = width; + arg.height = height; + arg.ignored_subcontrol = ignored_subcontrol; - ei->next = NULL; - ei->x = x; - ei->y = y; - ei->width = width; - ei->height = height; + map_over_subcontrols (f, redisplay_unmap_subcontrols_mapper, &arg); +} - /* we have to add the exposure to the end of the list, since we - want to check the oldest events first. for speed we keep a record - of the end so that we can add right to it. */ - if (f->subwindow_exposures_tail) - { - f->subwindow_exposures_tail->next = ei; - } - if (!f->subwindow_exposures) - { - f->subwindow_exposures = ei; - } - f->subwindow_exposures_tail = ei; - } +struct fmsarg +{ + int x; + int y; + int width; + int height; +}; + +static int +find_matching_subcontrol_mapper (Lisp_Object key, Lisp_Object value, + void *closure) +{ + Lisp_Image_Instance *ii; + struct fmsarg *arg = (struct fmsarg *) closure; + + if (!IMAGE_INSTANCEP (value)) + return 0; + ii = XIMAGE_INSTANCE (value); + + if (IMAGE_INSTANCE_SUBCONTROL_DISPLAYEDP (ii) + && IMAGE_INSTANCE_DISPLAY_X (ii) <= arg->x + && IMAGE_INSTANCE_DISPLAY_Y (ii) <= arg->y + && IMAGE_INSTANCE_DISPLAY_X (ii) + + IMAGE_INSTANCE_DISPLAY_WIDTH (ii) >= arg->x + arg->width + && IMAGE_INSTANCE_DISPLAY_Y (ii) + + IMAGE_INSTANCE_DISPLAY_HEIGHT (ii) >= arg->y + arg->height) + return 1; + + return 0; } /**************************************************************************** - find_matching_subwindow + find_matching_subcontrol - See if there is a subwindow that completely encloses the requested + See if there is a subcontrol that completely encloses the requested area. ****************************************************************************/ int -find_matching_subwindow (struct frame* f, int x, int y, int width, int height) +find_matching_subcontrol (struct frame *f, int x, int y, int width, + int height) { - Lisp_Object rest; + struct fmsarg arg; - LIST_LOOP (rest, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f))) - { - Lisp_Image_Instance *ii = XIMAGE_INSTANCE (XCAR (rest)); + arg.x = x; + arg.y = y; + arg.width = width; + arg.height = height; - if (IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) - && - IMAGE_INSTANCE_DISPLAY_X (ii) <= x - && - IMAGE_INSTANCE_DISPLAY_Y (ii) <= y - && - IMAGE_INSTANCE_DISPLAY_X (ii) - + IMAGE_INSTANCE_DISPLAY_WIDTH (ii) >= x + width - && - IMAGE_INSTANCE_DISPLAY_Y (ii) - + IMAGE_INSTANCE_DISPLAY_HEIGHT (ii) >= y + height) - { - return 1; - } - } - return 0; + return map_over_subcontrols (f, find_matching_subcontrol_mapper, &arg); } - - -/***************************************************************************** - * subwindow functions * - *****************************************************************************/ -/* Update the displayed characteristics of a subwindow. This function - should generally only get called if the subwindow is actually +/* Update the displayed characteristics of a subcontrol. This function + should generally only get called if the subcontrol is actually dirty. */ void -redisplay_subwindow (Lisp_Object subwindow) +redisplay_subcontrol (Lisp_Object subcontrol) { - Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow); + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (subcontrol); int count = specpdl_depth (); /* The update method is allowed to call eval. Since it is quite ＠＠ -4648,12 +6036,12 ＠＠ Fsignal will abort. */ specbind (Qinhibit_quit, Qt); - ERROR_CHECK_IMAGE_INSTANCE (subwindow); + ERROR_CHECK_IMAGE_INSTANCE (subcontrol); - if (WIDGET_IMAGE_INSTANCEP (subwindow)) + if (WIDGET_IMAGE_INSTANCEP (subcontrol)) { - if (image_instance_changed (subwindow)) - redisplay_widget (subwindow); + if (image_instance_changed (subcontrol)) + redisplay_widget (subcontrol); /* Reset the changed flags. */ IMAGE_INSTANCE_WIDGET_FACE_CHANGED (ii) = 0; IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii) = 0; ＠＠ -4678,8 +6066,8 ＠＠ way round - it simply means that we will get more displays than we might need. We can get better hashing by making the depth negative - currently it will recurse down 7 levels.*/ - IMAGE_INSTANCE_DISPLAY_HASH (ii) = internal_hash (subwindow, - IMAGE_INSTANCE_HASH_DEPTH); + IMAGE_INSTANCE_DISPLAY_HASH (ii) = + internal_hash (subcontrol, IMAGE_INSTANCE_HASH_DEPTH); unbind_to (count); } ＠＠ -4694,18 +6082,18 ＠＠ redisplay. This would obviate the need for any of this trickery with hashcodes. */ int -image_instance_changed (Lisp_Object subwindow) +image_instance_changed (Lisp_Object subcontrol) { - Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow); + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (subcontrol); - if (internal_hash (subwindow, IMAGE_INSTANCE_HASH_DEPTH) != + if (internal_hash (subcontrol, IMAGE_INSTANCE_HASH_DEPTH) != IMAGE_INSTANCE_DISPLAY_HASH (ii)) return 1; /* #### I think there is probably a bug here. This gets called for layouts - and yet the pending items are always nil for layouts. We are saved by layout optimization, but I'm undecided as to what the correct fix is. */ - else if (WIDGET_IMAGE_INSTANCEP (subwindow) + else if (WIDGET_IMAGE_INSTANCEP (subcontrol) && (!internal_equal_trapping_problems (Qglyph, "bad subwindow instantiator", /* in this case we really don't want to be ＠＠ -4724,52 +6112,49 ＠＠ return 0; } -/* Update all the subwindows on a frame. */ +static int +update_widget_instances_mapper (Lisp_Object key, Lisp_Object value, + void *closure) +{ + if (IMAGE_INSTANCEP (value)) + { + /* #### What about text image instances? */ + if (XIMAGE_INSTANCE_SUBCONTROL_DISPLAYEDP (value) + && image_instance_changed (value)) + set_image_instance_dirty_p (value, 1); + } + + return 0; +} + +/* Update all the subcontrols on a frame. */ void update_widget_instances (Lisp_Object frame) { - struct frame* f; - Lisp_Object rest; - /* Its possible for the preceding callback to have deleted the frame, so cope with this. */ if (!FRAMEP (frame) || !FRAME_LIVE_P (XFRAME (frame))) return; - CHECK_FRAME (frame); - f = XFRAME (frame); - - /* If we get called we know something has changed. */ - LIST_LOOP (rest, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f))) - { - Lisp_Object widget = XCAR (rest); - - if (XIMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (widget) - && - image_instance_changed (widget)) - { - set_image_instance_dirty_p (widget, 1); - MARK_FRAME_GLYPHS_CHANGED (f); - } - } + map_over_subcontrols (XFRAME (frame), update_widget_instances_mapper, NULL); } -/* remove a subwindow from its frame */ +/* remove a subcontrol from its frame */ void -unmap_subwindow (Lisp_Object subwindow) +unmap_subcontrol (Lisp_Object subcontrol) { - Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow); - struct frame* f; + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (subcontrol); + struct frame *f; - ERROR_CHECK_IMAGE_INSTANCE (subwindow); + ERROR_CHECK_IMAGE_INSTANCE (subcontrol); if (!(image_instance_type_to_mask (IMAGE_INSTANCE_TYPE (ii)) & (IMAGE_WIDGET_MASK | IMAGE_SUBWINDOW_MASK)) - || !IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii)) + || !IMAGE_INSTANCE_SUBCONTROL_DISPLAYEDP (ii)) return; #ifdef DEBUG_WIDGETS - stderr_out ("unmapping subwindow %p\n", IMAGE_INSTANCE_SUBWINDOW_ID (ii)); + stderr_out ("unmapping subcontrol %p\n", IMAGE_INSTANCE_SUBCONTROL_ID (ii)); #endif f = XFRAME (IMAGE_INSTANCE_FRAME (ii)); ＠＠ -4777,29 +6162,29 ＠＠ register_ignored_expose (f, IMAGE_INSTANCE_DISPLAY_X (ii), IMAGE_INSTANCE_DISPLAY_Y (ii), IMAGE_INSTANCE_DISPLAY_WIDTH (ii), - IMAGE_INSTANCE_DISPLAY_HEIGHT (ii)); - IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0; + IMAGE_INSTANCE_DISPLAY_HEIGHT (ii)); + IMAGE_INSTANCE_SUBCONTROL_DISPLAYEDP (ii) = 0; MAYBE_DEVMETH (XDEVICE (IMAGE_INSTANCE_DEVICE (ii)), - unmap_subwindow, (ii)); + unmap_subcontrol, (ii)); } -/* show a subwindow in its frame */ +/* show a subcontrol in its frame */ void -map_subwindow (Lisp_Object subwindow, int x, int y, +map_subcontrol (Lisp_Object subcontrol, int x, int y, struct display_glyph_area *dga) { - Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow); + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (subcontrol); - ERROR_CHECK_IMAGE_INSTANCE (subwindow); + ERROR_CHECK_IMAGE_INSTANCE (subcontrol); if (!(image_instance_type_to_mask (IMAGE_INSTANCE_TYPE (ii)) & (IMAGE_WIDGET_MASK | IMAGE_SUBWINDOW_MASK))) return; #ifdef DEBUG_WIDGETS - stderr_out ("mapping subwindow %p, %dx%d＠%d+%d\n", - IMAGE_INSTANCE_SUBWINDOW_ID (ii), + stderr_out ("mapping subcontrol %p, %dx%d＠%d+%d\n", + IMAGE_INSTANCE_SUBCONTROL_ID (ii), dga->width, dga->height, x, y); #endif /* Error check by side effect */ ＠＠ -4810,10 +6195,99 ＠＠ IMAGE_INSTANCE_DISPLAY_HEIGHT (ii) = dga->height; MAYBE_DEVMETH (DOMAIN_XDEVICE (ii->domain), - map_subwindow, (ii, x, y, dga)); - IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 1; + map_subcontrol, (ii, x, y, dga)); + IMAGE_INSTANCE_SUBCONTROL_DISPLAYEDP (ii) = 1; +} + +/*************************************************************************** + * subcontrol exposure ignorance * + ***************************************************************************/ +/* when we unmap subcontrols the associated window system will generate + expose events. This we do not want as redisplay already copes with + the repainting necessary. Worse, we can get in an endless cycle of + redisplay if we are not careful. Thus we keep a per-frame list of + expose events that are going to come and ignore them as + required. */ + +struct expose_ignore_blocktype +{ + Blocktype_declare (struct expose_ignore); +} *the_expose_ignore_blocktype; + +int +check_for_ignored_expose (struct frame *f, int x, int y, int width, + int height) +{ + struct expose_ignore *ei, *prev; + /* the ignore list is FIFO so we should generally get a match with + the first element in the list */ + for (ei = f->subcontrol_exposures, prev = 0; ei; ei = ei->next) + { + /* Checking for exact matches just isn't good enough as we + might get exposures for partially obscured subcontrols, thus + we have to check for overlaps. Being conservative, we will + check for exposures wholly contained by the subcontrol - this + might give us what we want.*/ + if (ei->x <= x && ei->y <= y + && ei->x + ei->width >= x + width + && ei->y + ei->height >= y + height) + { +#ifdef DEBUG_WIDGETS + stderr_out ("ignored %d+%d, %dx%d for exposure %d+%d, %dx%d\n", + x, y, width, height, ei->x, ei->y, ei->width, + ei->height); +#endif + if (!prev) + f->subcontrol_exposures = ei->next; + else + prev->next = ei->next; + + if (ei == f->subcontrol_exposures_tail) + f->subcontrol_exposures_tail = prev; + + Blocktype_free (the_expose_ignore_blocktype, ei); + return 1; + } + prev = ei; + } + return 0; } +static void +register_ignored_expose (struct frame *f, int x, int y, int width, int height) +{ + if (!hold_ignored_expose_registration) + { + struct expose_ignore *ei; + + ei = Blocktype_alloc (the_expose_ignore_blocktype); + + ei->next = NULL; + ei->x = x; + ei->y = y; + ei->width = width; + ei->height = height; + + /* we have to add the exposure to the end of the list, since we + want to check the oldest events first. for speed we keep a record + of the end so that we can add right to it. */ + if (f->subcontrol_exposures_tail) + { + f->subcontrol_exposures_tail->next = ei; + } + if (!f->subcontrol_exposures) + { + f->subcontrol_exposures = ei; + } + f->subcontrol_exposures_tail = ei; + } +} + + +/*************************************************************************** + * subwindows * + ***************************************************************************/ + static int subwindow_possible_dest_types (void) { ＠＠ -4846,8 +6320,8 ＠＠ incompatible_image_types (instantiator, dest_mask, IMAGE_SUBWINDOW_MASK); ii->data = 0; - IMAGE_INSTANCE_SUBWINDOW_ID (ii) = 0; - IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0; + IMAGE_INSTANCE_SUBCONTROL_ID (ii) = 0; + IMAGE_INSTANCE_SUBCONTROL_DISPLAYEDP (ii) = 0; if (INTP (width)) { ＠＠ -4855,7 +6329,7 ＠＠ if (XINT (width) > 1) w = XINT (width); IMAGE_INSTANCE_WIDTH (ii) = w; - IMAGE_INSTANCE_SUBWINDOW_H_RESIZEP (ii) = 0; + IMAGE_INSTANCE_SUBCONTROL_H_RESIZEP (ii) = 0; } if (INTP (height)) ＠＠ -4864,7 +6338,7 ＠＠ if (XINT (height) > 1) h = XINT (height); IMAGE_INSTANCE_HEIGHT (ii) = h; - IMAGE_INSTANCE_SUBWINDOW_V_RESIZEP (ii) = 0; + IMAGE_INSTANCE_SUBCONTROL_V_RESIZEP (ii) = 0; } } ＠＠ -4872,7 +6346,7 ＠＠ #### It should really query the enclose window for geometry. */ static void subwindow_query_geometry (Lisp_Object UNUSED (image_instance), - int* width, int* height, + int *width, int *height, enum image_instance_geometry UNUSED (disp), Lisp_Object UNUSED (domain)) { ＠＠ -4880,32 +6354,25 ＠＠ if (height) *height = 20; } -DEFUN ("subwindowp", Fsubwindowp, 1, 1, 0, /* -Return non-nil if OBJECT is a subwindow. -*/ - (object)) -{ - CHECK_IMAGE_INSTANCE (object); - return (XIMAGE_INSTANCE_TYPE (object) == IMAGE_SUBWINDOW) ? Qt : Qnil; -} - DEFUN ("image-instance-subwindow-id", Fimage_instance_subwindow_id, 1, 1, 0, /* Return the window id of SUBWINDOW as a number. +SUBWINDOW is a subwindow image instance. */ (subwindow)) { CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow); - return make_int ((EMACS_INT) XIMAGE_INSTANCE_SUBWINDOW_ID (subwindow)); + return make_int ((EMACS_INT) XIMAGE_INSTANCE_SUBCONTROL_ID (subwindow)); } DEFUN ("resize-subwindow", Fresize_subwindow, 1, 3, 0, /* Resize SUBWINDOW to WIDTH x HEIGHT. +SUBWINDOW is a subwindow image instance. If a value is nil that parameter is not changed. */ (subwindow, width, height)) { int neww, newh; - Lisp_Image_Instance* ii; + Lisp_Image_Instance *ii; CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow); ii = XIMAGE_INSTANCE (subwindow); ＠＠ -4931,12 +6398,13 ＠＠ DEFUN ("force-subwindow-map", Fforce_subwindow_map, 1, 1, 0, /* Generate a Map event for SUBWINDOW. +SUBWINDOW is a subwindow image instance. */ (subwindow)) { CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow); #if 0 - map_subwindow (subwindow, 0, 0); + map_subcontrol (subwindow, 0, 0); #endif return subwindow; } ＠＠ -5043,25 +6511,19 ＠＠ if (IMAGE_INSTANCEP (value)) { - Lisp_Image_Instance* ii = XIMAGE_INSTANCE (value); + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (value); if (COLOR_PIXMAP_IMAGE_INSTANCEP (value) - && - IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii) > 1 - && - !disable_animated_pixmaps) + && IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii) > 1 + && !disable_animated_pixmaps) { /* Increment the index of the image slice we are currently viewing. */ IMAGE_INSTANCE_PIXMAP_SLICE (ii) = (IMAGE_INSTANCE_PIXMAP_SLICE (ii) + 1) % IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii); - /* We might need to kick redisplay at this point - but we - also might not. */ - MARK_DEVICE_FRAMES_GLYPHS_CHANGED - (XDEVICE (image_instance_device (value))); - /* Cascade dirtiness so that we can have an animated glyph in a layout - for instance. */ + /* Mark the image instance and glyph dirty so it gets + redisplayed. */ set_image_instance_dirty_p (value, 1); } } ＠＠ -5149,6 +6611,7 ＠＠ DEFSYMBOL (Qpointer_image_instance_p); DEFSYMBOL (Qwidget_image_instance_p); DEFSYMBOL (Qsubwindow_image_instance_p); + DEFSYMBOL (Qsubcontrol_image_instance_p); DEFSUBR (Fmake_image_instance); DEFSUBR (Fimage_instance_p); ＠＠ -5157,7 +6620,8 ＠＠ DEFSUBR (Fimage_instance_type_list); DEFSUBR (Fimage_instance_name); DEFSUBR (Fimage_instance_domain); - DEFSUBR (Fimage_instance_instantiator); + DEFSUBR (Fimage_instance_parent); + DEFSUBR (Fimage_instance_children); DEFSUBR (Fimage_instance_string); DEFSUBR (Fimage_instance_file_name); DEFSUBR (Fimage_instance_mask_file_name); ＠＠ -5168,10 +6632,29 ＠＠ DEFSUBR (Fimage_instance_hotspot_y); DEFSUBR (Fimage_instance_foreground); DEFSUBR (Fimage_instance_background); - DEFSUBR (Fimage_instance_property); + DEFSUBR (Fimage_instance_instantiator); + DEFSUBR (Fmap_image_instance); + DEFSUBR (Ffind_image_instance); DEFSUBR (Fcolorize_image_instance); + DEFSUBR (Ffocus_image_instance); + + /* instantiators */ + + DEFSUBR (Fmake_instantiator); + DEFSUBR (Fset_instantiator_property); + DEFSUBR (Finstantiator_property); + DEFSUBR (Finstantiator_properties); + DEFSUBR (Finstantiator_type); + DEFSUBR (Finstantiator_parent); + DEFSUBR (Fmap_instantiator); + DEFSUBR (Ffind_instantiator); + DEFSUBR (Fadd_instantiator_item); + DEFSUBR (Fdelete_instantiator_item); + DEFSUBR (Fget_instantiator_item); + DEFSUBR (Fget_instantiator_item_position); + /* subwindows */ - DEFSUBR (Fsubwindowp); + DEFSUBR (Fimage_instance_subwindow_id); DEFSUBR (Fresize_subwindow); DEFSUBR (Fforce_subwindow_map); ＠＠ -5204,7 +6687,6 ＠＠ DEFSUBR (Fglyph_ascent); DEFSUBR (Fglyph_descent); DEFSUBR (Fglyph_height); - DEFSUBR (Fset_instantiator_property); /* Qbuffer defined in general.c. */ /* Qpointer defined above */ ＠＠ -5332,25 +6814,31 ＠＠ IIFORMAT_HAS_SHARED_METHOD (string, governing_domain, subwindow); IIFORMAT_HAS_METHOD (string, possible_dest_types); IIFORMAT_HAS_METHOD (string, instantiate); - IIFORMAT_VALID_KEYWORD (string, Q_data, check_valid_string); - /* Do this so we can set strings. */ - /* #### Andy, what is this? This is a bogus format and should not be - visible to the user. */ - INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (text, "text"); - IIFORMAT_HAS_METHOD (text, update); - IIFORMAT_HAS_METHOD (text, query_geometry); INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (formatted_string, "formatted-string"); - IIFORMAT_HAS_METHOD (formatted_string, validate); - IIFORMAT_HAS_METHOD (formatted_string, possible_dest_types); + IIFORMAT_HAS_SHARED_METHOD (formatted_string, validate, string); + IIFORMAT_HAS_SHARED_METHOD (formatted_string, governing_domain, subwindow); + IIFORMAT_HAS_SHARED_METHOD (formatted_string, possible_dest_types, string); IIFORMAT_HAS_METHOD (formatted_string, instantiate); IIFORMAT_VALID_KEYWORD (formatted_string, Q_data, check_valid_string); + /* #### Note: The next two bogus formats exist because of confusion + #### between instantiator formats and instance types. Some methods + #### should depend on the one, some on the other, but we have only + #### format methods. Things are further confused by widgets, where + #### widget-instance methods vary depending on the widget-instance + #### type -- which is generally identical with the instantiator + #### format. Thus, as a kludge, Andy made all methods vary on the + #### instantiator format, and added bogus formats for the instance + #### types. This should be cleaned up. */ + /* Do this so we can set strings. */ + INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (text, "text"); + IIFORMAT_HAS_METHOD (text, update); + IIFORMAT_HAS_METHOD (text, query_geometry); + /* Do this so pointers have geometry. */ - /* #### Andy, what is this? This is a bogus format and should not be - visible to the user. */ INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (pointer, "pointer"); IIFORMAT_HAS_SHARED_METHOD (pointer, query_geometry, subwindow); ＠＠ -5426,9 +6914,10 ＠＠ /* image instances */ - Vimage_instance_type_list = Fcons (Qnothing, - list6 (Qtext, Qmono_pixmap, Qcolor_pixmap, - Qpointer, Qsubwindow, Qwidget)); + Vimage_instance_type_list = + Fcons (Qnothing, + list6 (Qtext, Qmono_pixmap, Qcolor_pixmap, + Qpointer, Qsubwindow, Qwidget)); staticpro (&Vimage_instance_type_list); /* glyphs */ ＠＠ -5436,6 +6925,100 ＠＠ Vglyph_type_list = list3 (Qbuffer, Qpointer, Qicon); staticpro (&Vglyph_type_list); + /* Note that all of these built-in glyphs, as well as being CONST-LISP, + have symbol-value-handlers on them that issue informative error messages + saying what operation should be invoked in place of setq. */ + + /* The octal-escape glyph, control-arrow-glyph and + invisible-text-glyph are completely initialized in glyphs.el */ + + DEFVAR_CONST_LISP ("octal-escape-glyph", &Voctal_escape_glyph /* +What to prefix character codes displayed in octal with. +See `continuation-glyph'. +*/); + Voctal_escape_glyph = + allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed); + + DEFVAR_CONST_LISP ("control-arrow-glyph", &Vcontrol_arrow_glyph /* +What to use as an arrow for control characters. +See `continuation-glyph'. +*/); + Vcontrol_arrow_glyph = allocate_glyph (GLYPH_BUFFER, + redisplay_glyph_changed); + + DEFVAR_CONST_LISP ("invisible-text-glyph", &Vinvisible_text_glyph /* +What to use to indicate the presence of invisible text. +This is the glyph that is displayed when an ellipsis is called for +\(see `selective-display-ellipses' and `buffer-invisibility-spec'). +Normally this is three dots ("..."). +See `continuation-glyph'. +*/); + Vinvisible_text_glyph = allocate_glyph (GLYPH_BUFFER, + redisplay_glyph_changed); + + /* Partially initialized in glyphs.el */ + DEFVAR_CONST_LISP ("hscroll-glyph", &Vhscroll_glyph /* +What to display at the beginning of horizontally scrolled lines. +See `continuation-glyph'. +*/); + Vhscroll_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed); + + /* Partially initialized in glyphs-x.c, glyphs.el */ + DEFVAR_CONST_LISP ("truncation-glyph", &Vtruncation_glyph /* +What to display at the end of truncated lines. +See `continuation-glyph'. +*/ ); + Vtruncation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed); + + /* Partially initialized in glyphs-x.c, glyphs.el */ + DEFVAR_CONST_LISP ("continuation-glyph", &Vcontinuation_glyph /* +What to display at the end of wrapped lines. + +Note: There are six special, built-in glyphs used to display certain +special symbols in the buffer. They are: + +`continuation-glyph' The curving arrow marking a line continued onto + the next one. A backslash for TTY's. + +`truncation-glyph' The right-pointing arrow marking a line truncated, + and extending invisibly to the right. A $ for TTY's. + This happens when line-truncation is in effect + (`truncate-lines', `truncate-partial-width-windows') + + +`hscroll-glyph' The left-pointing arrow marking a line truncated, + and extending invisibly to the left. This happens + when line truncation is in effect and the screen has + been scrolled to the right. A $ for TTY's. + +`invisible-text-glyph' The indication that invisible text has been + suppressed, either through invisible extents or + selective display (`selective-display'). Normally + `...'. + +`control-arrow-glyph' The indication, normally a ^, used to display non- + printable characters in the buffer in the form ^X. + (See `ctl-arrow'.) + +`octal-escape-glyph' The indication, normally a \, used to display non- + printable characters in the buffer in the form \201. + (See `ctl-arrow'.) + + +Each of these are glyphs, and you can control them using `set-glyph-image'. +Note that currently it will not work to try to make any of these be +subcontrols (widgets or subwindows), as you will get infinite flashing. +*/ ); + Vcontinuation_glyph = + allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed); + + /* Partially initialized in glyphs-x.c, glyphs.el */ + DEFVAR_CONST_LISP ("xemacs-logo", &Vxemacs_logo /* +The glyph used to display the XEmacs logo at startup. +*/ ); + Vxemacs_logo = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed); + + #ifdef HAVE_WINDOW_SYSTEM Fprovide (Qxbm); #endif ＠＠ -5464,11 +7047,7 ＠＠ Default is t. */); disable_animated_pixmaps = 0; -} -void -specifier_vars_of_glyphs (void) -{ /* #### Can we GC here? The set_specifier_* calls definitely need */ /* protection. */ /* display tables */ ＠＠ -5518,11 +7097,11 ＠＠ -- a vector (each element of the vector is processed recursively; in such a case, nil elements in the vector are simply ignored) -#### At some point in the near future, display tables are likely to -be expanded to include other features, such as referencing characters -in particular fonts and allowing the character search to continue -all the way up the chain of specifier instantiators. These features -are necessary to properly display Unicode characters. +#### At some point in the near future, display tables are likely to be +expanded to include other features, such as referencing characters in +particular fonts and allowing the character search to continue all the way +up the chain of specifier instantiators. These features are necessary to +properly display Unicode characters. */ ); Vcurrent_display_table = Fmake_specifier (Qdisplay_table); set_specifier_fallback (Vcurrent_display_table, ＠＠ -5531,55 +7110,4 ＠＠ offsetof (struct window, display_table), some_window_value_changed, 0, 0, 0); -} - -void -complex_vars_of_glyphs (void) -{ - /* Partially initialized in glyphs-x.c, glyphs.el */ - DEFVAR_LISP ("truncation-glyph", &Vtruncation_glyph /* -What to display at the end of truncated lines. -*/ ); - Vtruncation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed); - - /* Partially initialized in glyphs-x.c, glyphs.el */ - DEFVAR_LISP ("continuation-glyph", &Vcontinuation_glyph /* -What to display at the end of wrapped lines. -*/ ); - Vcontinuation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed); - - /* The octal-escape glyph, control-arrow-glyph and - invisible-text-glyph are completely initialized in glyphs.el */ - - DEFVAR_LISP ("octal-escape-glyph", &Voctal_escape_glyph /* -What to prefix character codes displayed in octal with. -*/); - Voctal_escape_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed); - - DEFVAR_LISP ("control-arrow-glyph", &Vcontrol_arrow_glyph /* -What to use as an arrow for control characters. -*/); - Vcontrol_arrow_glyph = allocate_glyph (GLYPH_BUFFER, - redisplay_glyph_changed); - - DEFVAR_LISP ("invisible-text-glyph", &Vinvisible_text_glyph /* -What to use to indicate the presence of invisible text. -This is the glyph that is displayed when an ellipsis is called for -\(see `selective-display-ellipses' and `buffer-invisibility-spec'). -Normally this is three dots ("..."). -*/); - Vinvisible_text_glyph = allocate_glyph (GLYPH_BUFFER, - redisplay_glyph_changed); - - /* Partially initialized in glyphs.el */ - DEFVAR_LISP ("hscroll-glyph", &Vhscroll_glyph /* -What to display at the beginning of horizontally scrolled lines. -*/); - Vhscroll_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed); - - /* Partially initialized in glyphs-x.c, glyphs.el */ - DEFVAR_LISP ("xemacs-logo", &Vxemacs_logo /* -The glyph used to display the XEmacs logo at startup. -*/ ); - Vxemacs_logo = allocate_glyph (GLYPH_BUFFER, 0); } 1.38.6.1 +233 -215 XEmacs/xemacs/src/glyphs.h Index: glyphs.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/glyphs.h,v retrieving revision 1.38 retrieving revision 1.38.6.1 diff -u -r1.38 -r1.38.6.1 --- glyphs.h 2004/11/04 23:06:34 1.38 +++ glyphs.h 2005/02/16 00:43:26 1.38.6.1 ＠＠ -25,7 +25,7 ＠＠ #define INCLUDED_glyphs_h_ #include "specifier.h" -#include "window-impl.h" /* need for GLYPH_CACHEL_WIDTH */ +#include "window-impl.h" /* need for glyph_cachel_width */ /************************************************************************/ /* Image Instantiators */ ＠＠ -167,14 +167,15 ＠＠ Lisp_Object val); /* Asynchronously update properties. */ void (*update_method) (Lisp_Object image_instance, - Lisp_Object instantiator); + Lisp_Object instantiator, + Lisp_Object domain); void (*redisplay_method) (Lisp_Object image_instance); /* Find out the desired geometry, as given by disp, of this image instance. Actual geometry is stored in the appropriate slots in the image instance. */ void (*query_geometry_method) (Lisp_Object image_instance, - int* width, int* height, + int *width, int *height, enum image_instance_geometry disp, Lisp_Object domain); ＠＠ -362,8 +363,8 ＠＠ void check_valid_face (Lisp_Object data); void check_valid_vector (Lisp_Object data); -void initialize_subwindow_image_instance (Lisp_Image_Instance*); -void subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, +void subwindow_instantiate (Lisp_Object image_instance, + Lisp_Object instantiator, Lisp_Object pointer_fg, Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain); int subwindow_governing_domain (void); ＠＠ -371,7 +372,7 ＠＠ Lisp_Object pointer_fg, Lisp_Object pointer_bg, int dest_mask, Lisp_Object domain); void image_instance_query_geometry (Lisp_Object image_instance, - int* width, int* height, + int *width, int *height, enum image_instance_geometry disp, Lisp_Object domain); void image_instance_layout (Lisp_Object image_instance, ＠＠ -380,8 +381,10 ＠＠ int layout_layout (Lisp_Object image_instance, int width, int height, int xoffset, int yoffset, Lisp_Object domain); -int invalidate_glyph_geometry_maybe (Lisp_Object glyph_or_ii, struct window* w); -Lisp_Object make_image_instance_cache_hash_table (void); +int invalidate_glyph_geometry_maybe (Lisp_Object glyph_or_ii, + struct window *w, Lisp_Object matchspec); +Lisp_Object make_image_instance_device_cache (void); +Lisp_Object make_image_instance_frame_cache (void); DECLARE_DOESNT_RETURN (incompatible_image_types (Lisp_Object instantiator, int given_dest_mask, ＠＠ -439,14 +442,10 ＠＠ #ifdef ERROR_CHECK_GLYPHS void check_image_instance_structure (Lisp_Object instance); -void check_window_subwindow_cache (struct window* w); #define ERROR_CHECK_IMAGE_INSTANCE(ii) \ check_image_instance_structure (ii) -#define ERROR_CHECK_SUBWINDOW_CACHE(w) \ - check_window_subwindow_cache (w) #else #define ERROR_CHECK_IMAGE_INSTANCE(ii) -#define ERROR_CHECK_SUBWINDOW_CACHE(w) #endif enum image_instance_type ＠＠ -476,67 +475,7 ＠＠ #define image_instance_type_to_mask(type) \ ((int) (1 << ((int) (type) - 1))) -#define IMAGE_INSTANCE_TYPE_P(ii, type) \ -(IMAGE_INSTANCEP (ii) && XIMAGE_INSTANCE_TYPE (ii) == type) -#define NOTHING_IMAGE_INSTANCEP(ii) \ - IMAGE_INSTANCE_TYPE_P (ii, IMAGE_NOTHING) -#define TEXT_IMAGE_INSTANCEP(ii) \ - IMAGE_INSTANCE_TYPE_P (ii, IMAGE_TEXT) -#define MONO_PIXMAP_IMAGE_INSTANCEP(ii) \ - IMAGE_INSTANCE_TYPE_P (ii, IMAGE_MONO_PIXMAP) -#define COLOR_PIXMAP_IMAGE_INSTANCEP(ii) \ - IMAGE_INSTANCE_TYPE_P (ii, IMAGE_COLOR_PIXMAP) -#define POINTER_IMAGE_INSTANCEP(ii) \ - 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); \ - if (!NOTHING_IMAGE_INSTANCEP (x)) \ - x = wrong_type_argument (Qnothing_image_instance_p, (x)); \ -} while (0) - -#define CHECK_TEXT_IMAGE_INSTANCE(x) do { \ - CHECK_IMAGE_INSTANCE (x); \ - if (!TEXT_IMAGE_INSTANCEP (x)) \ - x = wrong_type_argument (Qtext_image_instance_p, (x)); \ -} while (0) - -#define CHECK_MONO_PIXMAP_IMAGE_INSTANCE(x) do { \ - CHECK_IMAGE_INSTANCE (x); \ - if (!MONO_PIXMAP_IMAGE_INSTANCEP (x)) \ - x = wrong_type_argument (Qmono_pixmap_image_instance_p, (x)); \ -} while (0) - -#define CHECK_COLOR_PIXMAP_IMAGE_INSTANCE(x) do { \ - CHECK_IMAGE_INSTANCE (x); \ - if (!COLOR_PIXMAP_IMAGE_INSTANCEP (x)) \ - x = wrong_type_argument (Qcolor_pixmap_image_instance_p, (x)); \ -} while (0) - -#define CHECK_POINTER_IMAGE_INSTANCE(x) do { \ - CHECK_IMAGE_INSTANCE (x); \ - if (!POINTER_IMAGE_INSTANCEP (x)) \ - x = wrong_type_argument (Qpointer_image_instance_p, (x)); \ -} while (0) - -#define CHECK_SUBWINDOW_IMAGE_INSTANCE(x) do { \ - CHECK_IMAGE_INSTANCE (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 text_image_instance { int descent; ＠＠ -555,15 +494,15 ＠＠ or a pointer */ Lisp_Object auxdata; /* list or Qnil: any additional data to be seen from lisp */ - void* mask; /* mask that can be seen from all windowing systems */ + void *mask; /* mask that can be seen from all windowing systems */ }; -struct subwindow_image_instance +struct subcontrol_image_instance { - void* subwindow; /* specific devices can use this as necessary */ + void *subcontrol; /* specific devices can use this as necessary */ struct { /* We need these so we can do without - subwindow_cachel */ + subcontrol_cachel */ int x, y; int width, height; } display_data; ＠＠ -574,16 +513,45 ＠＠ unsigned int orientation : 1; /* Vertical or horizontal. */ unsigned int h_justification : 2; /* left, right or center. */ unsigned int v_justification : 2; /* top, bottom or center. */ + unsigned int wants_focus : 1; /* Should get the focus */ /* Face for colors and font. We specify this here because we want people to be able to put :face in the instantiator spec. Using glyph-face is more inconvenient, although more general. */ Lisp_Object face; Lisp_Object type; - Lisp_Object props; /* properties or border*/ - Lisp_Object items; /* a list of displayed gui_items */ + Lisp_Object tag; /* arbitrary value for easy lookup */ + /* properties or border. + + For layout widgets, describes the "border", which can be a title + (implemented as a separate widget) or something else (#### what?). + If the :border property of a layout widget is a vector (a widget + instantiator), then this field is an integer (#### what value?), and + the first child in CHILDREN is an internal widget instance for the + border. If :border is t, this is the symbol `etched-in'; otherwise, + it's :border. */ + Lisp_Object props; + /* Either a single gui-item or a list of them. The gui-item(s) + is/are created from the properties of the widget's instantiator + and those of its children, if any (but only the properties + recognized by the code in gui.c -- #### obviously bogus). It + appears that this will be a list when the widget has children but + is *NOT* a layout or native layout (e.g. it's a tree-view); in + this case, the first item in the list encapsulates the properties + of the widget itself, and the rest will actually be a tree whose + shape mirrors that of the children. + + This list supposedly contains entries only for currently displayed + children; as the displayed children change, the new structure is + constructed in PENDING_ITEMS and then copied into ITEMS. #### The + code that does this is complicated and difficult to follow and + it's not clear that it works correctly 100% of the time. */ + Lisp_Object items; Lisp_Object pending_items; /* gui_items that should be displayed */ - Lisp_Object children; /* a list of children */ + /* a list of children -- used for layout widgets; if PROPS (used in + this case as "border") is an integer, the first child is actually + an internal widget to display the "border" (a title, etc.). */ + Lisp_Object children; Lisp_Object width; /* dynamic width spec. */ Lisp_Object height; /* dynamic height spec. */ /* Change flags to augment dirty. */ ＠＠ -600,8 +568,8 ＠＠ since the domain may get deleted before us. */ Lisp_Object name; - /* The glyph from which we were instantiated. This is a weak - reference. */ + /* The glyph from which we were instantiated, or the surrounding image + instance in a layout tree. This is a weak reference. */ Lisp_Object parent; /* The instantiator from which we were instantiated. */ Lisp_Object instantiator; ＠＠ -611,19 +579,18 ＠＠ Hashcode display_hash; /* Hash value representing the structure of the image_instance when it was last displayed. */ - unsigned int dirty : 1; + unsigned int dirty__ : 1; unsigned int size_changed : 1; unsigned int text_changed : 1; unsigned int layout_changed : 1; unsigned int optimize_output : 1; /* For outputting layouts. */ unsigned int initialized : 1; /* When we're fully done. */ - unsigned int wants_initial_focus : 1; union { struct text_image_instance text; struct pixmap_image_instance pixmap; /* used for pointers as well */ - struct subwindow_image_instance subwindow; + struct subcontrol_image_instance subcontrol; } u; /* console-type- and image-type-specific data */ ＠＠ -650,7 +617,7 ＠＠ #define IMAGE_INSTANCE_NAME(i) ((i)->name) #define IMAGE_INSTANCE_PARENT(i) ((i)->parent) #define IMAGE_INSTANCE_INSTANTIATOR(i) ((i)->instantiator) -#define IMAGE_INSTANCE_GLYPH(i) (image_instance_parent_glyph(i)) +#define IMAGE_INSTANCE_GLYPH(i) image_instance_parent_glyph (i) #define IMAGE_INSTANCE_TYPE(i) ((i)->type) #define IMAGE_INSTANCE_XOFFSET(i) ((i)->x_offset) #define IMAGE_INSTANCE_YOFFSET(i) ((i)->y_offset) ＠＠ -662,7 +629,7 ＠＠ #define IMAGE_INSTANCE_PIXMAP_TYPE_P(i) \ ((IMAGE_INSTANCE_TYPE (i) == IMAGE_MONO_PIXMAP) \ || (IMAGE_INSTANCE_TYPE (i) == IMAGE_COLOR_PIXMAP)) -#define IMAGE_INSTANCE_DIRTYP(i) ((i)->dirty) +#define IMAGE_INSTANCE_DIRTYP(i) ((i)->dirty__) #define IMAGE_INSTANCE_NEEDS_LAYOUT(i) \ ((IMAGE_INSTANCE_DIRTYP (i) && IMAGE_INSTANCE_LAYOUT_CHANGED (i)) \ || (FRAMEP (IMAGE_INSTANCE_FRAME (i)) \ ＠＠ -670,17 +637,16 ＠＠ #define IMAGE_INSTANCE_FACE(i) \ (GLYPHP (IMAGE_INSTANCE_GLYPH (i)) ? \ XGLYPH_FACE (IMAGE_INSTANCE_GLYPH (i)) : Qnil) -#define IMAGE_INSTANCE_WANTS_INITIAL_FOCUS(i) ((i)->wants_initial_focus) /* Changed flags */ #define IMAGE_INSTANCE_TEXT_CHANGED(i) ((i)->text_changed) #define IMAGE_INSTANCE_SIZE_CHANGED(i) ((i)->size_changed) #define IMAGE_INSTANCE_WIDGET_FACE_CHANGED(i) \ - ((i)->u.subwindow.face_changed) + ((i)->u.subcontrol.face_changed) #define IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED(i) \ - ((i)->u.subwindow.items_changed) + ((i)->u.subcontrol.items_changed) #define IMAGE_INSTANCE_WIDGET_ACTION_OCCURRED(i) \ - ((i)->u.subwindow.action_occurred) + ((i)->u.subcontrol.action_occurred) #define IMAGE_INSTANCE_LAYOUT_CHANGED(i) ((i)->layout_changed) #define IMAGE_INSTANCE_OPTIMIZE_OUTPUT(i) ((i)->optimize_output) ＠＠ -712,74 +678,76 ＠＠ #define IMAGE_INSTANCE_PIXMAP_MAXSLICE(i) ((i)->u.pixmap.maxslice) #define IMAGE_INSTANCE_PIXMAP_TIMEOUT(i) ((i)->u.pixmap.timeout) -/* Subwindow properties */ -#define IMAGE_INSTANCE_SUBWINDOW_ID(i) ((i)->u.subwindow.subwindow) +/* Subcontrol properties */ +#define IMAGE_INSTANCE_SUBCONTROL_ID(i) ((i)->u.subcontrol.subcontrol) /* Display data. */ -#define IMAGE_INSTANCE_DISPLAY_X(i) ((i)->u.subwindow.display_data.x) -#define IMAGE_INSTANCE_DISPLAY_Y(i) ((i)->u.subwindow.display_data.y) +#define IMAGE_INSTANCE_DISPLAY_X(i) ((i)->u.subcontrol.display_data.x) +#define IMAGE_INSTANCE_DISPLAY_Y(i) ((i)->u.subcontrol.display_data.y) #define IMAGE_INSTANCE_DISPLAY_WIDTH(i) \ - ((i)->u.subwindow.display_data.width) + ((i)->u.subcontrol.display_data.width) #define IMAGE_INSTANCE_DISPLAY_HEIGHT(i) \ - ((i)->u.subwindow.display_data.height) -#define IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP(i) \ -((i)->u.subwindow.being_displayed) -#define IMAGE_INSTANCE_SUBWINDOW_V_RESIZEP(i) \ -((i)->u.subwindow.v_resize) -#define IMAGE_INSTANCE_SUBWINDOW_H_RESIZEP(i) \ -((i)->u.subwindow.h_resize) -#define IMAGE_INSTANCE_SUBWINDOW_ORIENT(i) \ -((i)->u.subwindow.orientation) -#define IMAGE_INSTANCE_SUBWINDOW_H_JUSTIFY(i) \ -((i)->u.subwindow.h_justification) -#define IMAGE_INSTANCE_SUBWINDOW_V_JUSTIFY(i) \ -((i)->u.subwindow.v_justification) -#define IMAGE_INSTANCE_SUBWINDOW_RIGHT_JUSTIFIED(i) \ - (IMAGE_INSTANCE_SUBWINDOW_H_JUSTIFY(i) == LAYOUT_JUSTIFY_RIGHT) -#define IMAGE_INSTANCE_SUBWINDOW_LEFT_JUSTIFIED(i) \ - (IMAGE_INSTANCE_SUBWINDOW_H_JUSTIFY(i) == LAYOUT_JUSTIFY_LEFT) -#define IMAGE_INSTANCE_SUBWINDOW_TOP_JUSTIFIED(i) \ - (IMAGE_INSTANCE_SUBWINDOW_V_JUSTIFY(i) == LAYOUT_JUSTIFY_TOP) -#define IMAGE_INSTANCE_SUBWINDOW_BOTTOM_JUSTIFIED(i) \ - (IMAGE_INSTANCE_SUBWINDOW_V_JUSTIFY(i) == LAYOUT_JUSTIFY_BOTTOM) -#define IMAGE_INSTANCE_SUBWINDOW_H_CENTERED(i) \ - (IMAGE_INSTANCE_SUBWINDOW_H_JUSTIFY(i) == LAYOUT_JUSTIFY_CENTER) -#define IMAGE_INSTANCE_SUBWINDOW_V_CENTERED(i) \ - (IMAGE_INSTANCE_SUBWINDOW_V_JUSTIFY(i) == LAYOUT_JUSTIFY_CENTER) -#define IMAGE_INSTANCE_SUBWINDOW_LOGICAL_LAYOUT(i) \ - (IMAGE_INSTANCE_SUBWINDOW_ORIENT (i) \ - == LAYOUT_VERTICAL && !IMAGE_INSTANCE_SUBWINDOW_V_CENTERED (i)) + ((i)->u.subcontrol.display_data.height) +#define IMAGE_INSTANCE_SUBCONTROL_DISPLAYEDP(i) \ +((i)->u.subcontrol.being_displayed) +#define IMAGE_INSTANCE_SUBCONTROL_V_RESIZEP(i) \ +((i)->u.subcontrol.v_resize) +#define IMAGE_INSTANCE_SUBCONTROL_H_RESIZEP(i) \ +((i)->u.subcontrol.h_resize) +#define IMAGE_INSTANCE_SUBCONTROL_ORIENT(i) \ +((i)->u.subcontrol.orientation) +#define IMAGE_INSTANCE_SUBCONTROL_H_JUSTIFY(i) \ +((i)->u.subcontrol.h_justification) +#define IMAGE_INSTANCE_SUBCONTROL_V_JUSTIFY(i) \ +((i)->u.subcontrol.v_justification) +#define IMAGE_INSTANCE_SUBCONTROL_RIGHT_JUSTIFIED(i) \ + (IMAGE_INSTANCE_SUBCONTROL_H_JUSTIFY(i) == LAYOUT_JUSTIFY_RIGHT) +#define IMAGE_INSTANCE_SUBCONTROL_LEFT_JUSTIFIED(i) \ + (IMAGE_INSTANCE_SUBCONTROL_H_JUSTIFY(i) == LAYOUT_JUSTIFY_LEFT) +#define IMAGE_INSTANCE_SUBCONTROL_TOP_JUSTIFIED(i) \ + (IMAGE_INSTANCE_SUBCONTROL_V_JUSTIFY(i) == LAYOUT_JUSTIFY_TOP) +#define IMAGE_INSTANCE_SUBCONTROL_BOTTOM_JUSTIFIED(i) \ + (IMAGE_INSTANCE_SUBCONTROL_V_JUSTIFY(i) == LAYOUT_JUSTIFY_BOTTOM) +#define IMAGE_INSTANCE_SUBCONTROL_H_CENTERED(i) \ + (IMAGE_INSTANCE_SUBCONTROL_H_JUSTIFY(i) == LAYOUT_JUSTIFY_CENTER) +#define IMAGE_INSTANCE_SUBCONTROL_V_CENTERED(i) \ + (IMAGE_INSTANCE_SUBCONTROL_V_JUSTIFY(i) == LAYOUT_JUSTIFY_CENTER) +#define IMAGE_INSTANCE_SUBCONTROL_LOGICAL_LAYOUT(i) \ + (IMAGE_INSTANCE_SUBCONTROL_ORIENT (i) \ + == LAYOUT_VERTICAL && !IMAGE_INSTANCE_SUBCONTROL_V_CENTERED (i)) -#define IMAGE_INSTANCE_SUBWINDOW_FACE(i) \ -((i)->u.subwindow.face) +#define IMAGE_INSTANCE_SUBCONTROL_FACE(i) \ +((i)->u.subcontrol.face) /* Widget properties */ #define IMAGE_INSTANCE_WIDGET_WIDTH(i) \ IMAGE_INSTANCE_WIDTH(i) #define IMAGE_INSTANCE_WIDGET_HEIGHT(i) \ IMAGE_INSTANCE_HEIGHT(i) -#define IMAGE_INSTANCE_WIDGET_WIDTH_SUBR(i) ((i)->u.subwindow.width) -#define IMAGE_INSTANCE_WIDGET_HEIGHT_SUBR(i) ((i)->u.subwindow.height) -#define IMAGE_INSTANCE_WIDGET_TYPE(i) ((i)->u.subwindow.type) -#define IMAGE_INSTANCE_WIDGET_PROPS(i) ((i)->u.subwindow.props) +#define IMAGE_INSTANCE_WIDGET_WIDTH_SUBR(i) ((i)->u.subcontrol.width) +#define IMAGE_INSTANCE_WIDGET_HEIGHT_SUBR(i) ((i)->u.subcontrol.height) +#define IMAGE_INSTANCE_WIDGET_TYPE(i) ((i)->u.subcontrol.type) +#define IMAGE_INSTANCE_WIDGET_PROPS(i) ((i)->u.subcontrol.props) #define SET_IMAGE_INSTANCE_WIDGET_FACE(i,f) \ - ((i)->u.subwindow.face = f) + ((i)->u.subcontrol.face = f) #define IMAGE_INSTANCE_WIDGET_FACE(i) \ - (!NILP ((i)->u.subwindow.face) ? (i)->u.subwindow.face : \ + (!NILP ((i)->u.subcontrol.face) ? (i)->u.subcontrol.face : \ !NILP (IMAGE_INSTANCE_FACE (i)) ? IMAGE_INSTANCE_FACE (i) : \ Vwidget_face) -#define IMAGE_INSTANCE_WIDGET_ITEMS(i) ((i)->u.subwindow.items) +#define IMAGE_INSTANCE_WIDGET_ITEMS(i) ((i)->u.subcontrol.items) #define IMAGE_INSTANCE_WIDGET_PENDING_ITEMS(i) \ - ((i)->u.subwindow.pending_items) + ((i)->u.subcontrol.pending_items) #define IMAGE_INSTANCE_WIDGET_ITEM(i) \ (CONSP (IMAGE_INSTANCE_WIDGET_ITEMS (i)) ? \ XCAR (IMAGE_INSTANCE_WIDGET_ITEMS (i)) : \ IMAGE_INSTANCE_WIDGET_ITEMS (i)) #define IMAGE_INSTANCE_WIDGET_TEXT(i) \ XGUI_ITEM (IMAGE_INSTANCE_WIDGET_ITEM (i))->name +#define IMAGE_INSTANCE_WIDGET_WANTS_FOCUS(i) ((i)->u.subcontrol.wants_focus) +#define IMAGE_INSTANCE_WIDGET_TAG(i) ((i)->u.subcontrol.tag) /* Layout properties */ -#define IMAGE_INSTANCE_LAYOUT_CHILDREN(i) ((i)->u.subwindow.children) -#define IMAGE_INSTANCE_LAYOUT_BORDER(i) ((i)->u.subwindow.props) +#define IMAGE_INSTANCE_LAYOUT_CHILDREN(i) ((i)->u.subcontrol.children) +#define IMAGE_INSTANCE_LAYOUT_BORDER(i) ((i)->u.subcontrol.props) #define XIMAGE_INSTANCE_DOMAIN(i) \ IMAGE_INSTANCE_DOMAIN (XIMAGE_INSTANCE (i)) ＠＠ -884,14 +852,18 ＠＠ IMAGE_INSTANCE_WIDGET_TEXT (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_WIDGET_ACTION_OCCURRED(i) \ IMAGE_INSTANCE_WIDGET_ACTION_OCCURRED (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_WIDGET_WANTS_FOCUS(i) \ + IMAGE_INSTANCE_WIDGET_WANTS_FOCUS (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_WIDGET_TAG(i) \ + IMAGE_INSTANCE_WIDGET_TAG (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_LAYOUT_CHILDREN(i) \ IMAGE_INSTANCE_LAYOUT_CHILDREN (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_LAYOUT_BORDER(i) \ IMAGE_INSTANCE_LAYOUT_BORDER (XIMAGE_INSTANCE (i)) -#define XIMAGE_INSTANCE_SUBWINDOW_ID(i) \ - IMAGE_INSTANCE_SUBWINDOW_ID (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_SUBCONTROL_ID(i) \ + IMAGE_INSTANCE_SUBCONTROL_ID (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_DISPLAY_X(i) \ IMAGE_INSTANCE_DISPLAY_X (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_DISPLAY_Y(i) \ ＠＠ -900,17 +872,96 ＠＠ IMAGE_INSTANCE_DISPLAY_WIDTH (XIMAGE_INSTANCE (i)) #define XIMAGE_INSTANCE_DISPLAY_HEIGHT(i) \ IMAGE_INSTANCE_DISPLAY_HEIGHT (XIMAGE_INSTANCE (i)) -#define XIMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP(i) \ - IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (XIMAGE_INSTANCE (i)) -#define XIMAGE_INSTANCE_SUBWINDOW_ORIENT(i) \ - IMAGE_INSTANCE_SUBWINDOW_ORIENT (XIMAGE_INSTANCE (i)) -#define XIMAGE_INSTANCE_SUBWINDOW_JUSTIFY(i) \ - IMAGE_INSTANCE_SUBWINDOW_JUSTIFY (XIMAGE_INSTANCE (i)) -#define XIMAGE_INSTANCE_SUBWINDOW_FACE(i) \ - IMAGE_INSTANCE_SUBWINDOW_FACE (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_SUBCONTROL_DISPLAYEDP(i) \ + IMAGE_INSTANCE_SUBCONTROL_DISPLAYEDP (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_SUBCONTROL_ORIENT(i) \ + IMAGE_INSTANCE_SUBCONTROL_ORIENT (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_SUBCONTROL_JUSTIFY(i) \ + IMAGE_INSTANCE_SUBCONTROL_JUSTIFY (XIMAGE_INSTANCE (i)) +#define XIMAGE_INSTANCE_SUBCONTROL_FACE(i) \ + IMAGE_INSTANCE_SUBCONTROL_FACE (XIMAGE_INSTANCE (i)) + +DECLARE_INLINE_HEADER ( +int +IMAGE_INSTANCE_TYPE_P (Lisp_Object ii, enum image_instance_type type) +) +{ + return IMAGE_INSTANCEP (ii) && XIMAGE_INSTANCE_TYPE (ii) == type; +} + +#define NOTHING_IMAGE_INSTANCEP(ii) \ + IMAGE_INSTANCE_TYPE_P (ii, IMAGE_NOTHING) +#define TEXT_IMAGE_INSTANCEP(ii) \ + IMAGE_INSTANCE_TYPE_P (ii, IMAGE_TEXT) +#define MONO_PIXMAP_IMAGE_INSTANCEP(ii) \ + IMAGE_INSTANCE_TYPE_P (ii, IMAGE_MONO_PIXMAP) +#define COLOR_PIXMAP_IMAGE_INSTANCEP(ii) \ + IMAGE_INSTANCE_TYPE_P (ii, IMAGE_COLOR_PIXMAP) +#define POINTER_IMAGE_INSTANCEP(ii) \ + 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) + +DECLARE_INLINE_HEADER ( +int +SUBCONTROL_IMAGE_INSTANCEP (Lisp_Object ii) +) +{ + return IMAGE_INSTANCEP (ii) && + (XIMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW || + XIMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET); +} + +#define CHECK_NOTHING_IMAGE_INSTANCE(x) do { \ + CHECK_IMAGE_INSTANCE (x); \ + if (!NOTHING_IMAGE_INSTANCEP (x)) \ + x = wrong_type_argument (Qnothing_image_instance_p, (x)); \ +} while (0) + +#define CHECK_TEXT_IMAGE_INSTANCE(x) do { \ + CHECK_IMAGE_INSTANCE (x); \ + if (!TEXT_IMAGE_INSTANCEP (x)) \ + x = wrong_type_argument (Qtext_image_instance_p, (x)); \ +} while (0) + +#define CHECK_MONO_PIXMAP_IMAGE_INSTANCE(x) do { \ + CHECK_IMAGE_INSTANCE (x); \ + if (!MONO_PIXMAP_IMAGE_INSTANCEP (x)) \ + x = wrong_type_argument (Qmono_pixmap_image_instance_p, (x)); \ +} while (0) + +#define CHECK_COLOR_PIXMAP_IMAGE_INSTANCE(x) do { \ + CHECK_IMAGE_INSTANCE (x); \ + if (!COLOR_PIXMAP_IMAGE_INSTANCEP (x)) \ + x = wrong_type_argument (Qcolor_pixmap_image_instance_p, (x)); \ +} while (0) + +#define CHECK_POINTER_IMAGE_INSTANCE(x) do { \ + CHECK_IMAGE_INSTANCE (x); \ + if (!POINTER_IMAGE_INSTANCEP (x)) \ + x = wrong_type_argument (Qpointer_image_instance_p, (x)); \ +} while (0) + +#define CHECK_SUBWINDOW_IMAGE_INSTANCE(x) do { \ + CHECK_IMAGE_INSTANCE (x); \ + if (!SUBWINDOW_IMAGE_INSTANCEP (x)) \ + x = wrong_type_argument (Qsubwindow_image_instance_p, (x)); \ +} while (0) + +#define CHECK_SUBCONTROL_IMAGE_INSTANCE(x) do { \ + CHECK_IMAGE_INSTANCE (x); \ + if (!SUBWINDOW_IMAGE_INSTANCEP (x) \ + && !WIDGET_IMAGE_INSTANCEP (x)) \ + x = wrong_type_argument (Qsubcontrol_image_instance_p, (x));\ +} while (0) -#define MARK_IMAGE_INSTANCE_CHANGED(i) \ - (IMAGE_INSTANCE_DIRTYP (i) = 1); +#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) Lisp_Object image_instance_device (Lisp_Object instance); Lisp_Object image_instance_frame (Lisp_Object instance); ＠＠ -931,6 +982,11 ＠＠ Lisp_Object mask_file, Lisp_Object console_type); #endif +Lisp_Object overwrite_image_instance (Lisp_Object overwrite_me, + Lisp_Object data, Lisp_Object parent, + Lisp_Object domain, + Lisp_Object dest_types, + Lisp_Object noerror); /************************************************************************/ /* Glyph Object */ ＠＠ -961,7 +1017,7 ＠＠ void (*after_change) (Lisp_Object glyph, Lisp_Object property, Lisp_Object locale); - unsigned int dirty : 1; /* So that we can selectively + unsigned int dirty__ : 1; /* So that we can selectively redisplay changed glyphs. */ }; typedef struct Lisp_Glyph Lisp_Glyph; ＠＠ -996,7 +1052,7 ＠＠ #define GLYPH_CONTRIB_P(g) ((g)->contrib_p) #define GLYPH_BASELINE(g) ((g)->baseline) #define GLYPH_FACE(g) ((g)->face) -#define GLYPH_DIRTYP(g) ((g)->dirty) +#define GLYPH_DIRTYP(g) ((g)->dirty__) #define XGLYPH_TYPE(g) GLYPH_TYPE (XGLYPH (g)) #define XGLYPH_IMAGE(g) GLYPH_IMAGE (XGLYPH (g)) ＠＠ -1005,8 +1061,6 ＠＠ #define XGLYPH_FACE(g) GLYPH_FACE (XGLYPH (g)) #define XGLYPH_DIRTYP(g) GLYPH_DIRTYP (XGLYPH (g)) -#define MARK_GLYPH_CHANGED(g) (GLYPH_DIRTYP (g) = 1); - extern Lisp_Object Qxpm, Qxface, Qetched_in, Qetched_out, Qbevel_in, Qbevel_out; extern Lisp_Object Q_data, Q_file, Q_color_symbols, Qconst_glyph_variable; extern Lisp_Object Qxbm, Qedit_field, Qgroup, Qlabel, Qcombo_box, Qscrollbar; ＠＠ -1020,15 +1074,20 ＠＠ extern Lisp_Object Vxemacs_logo; -unsigned short glyph_width (Lisp_Object glyph, Lisp_Object domain); -unsigned short glyph_ascent (Lisp_Object glyph, Lisp_Object domain); -unsigned short glyph_descent (Lisp_Object glyph, Lisp_Object domain); -unsigned short glyph_height (Lisp_Object glyph, Lisp_Object domain); +unsigned short glyph_width (Lisp_Object glyph, Lisp_Object domain, + Lisp_Object matchspec); +unsigned short glyph_ascent (Lisp_Object glyph, Lisp_Object domain, + Lisp_Object matchspec); +unsigned short glyph_descent (Lisp_Object glyph, Lisp_Object domain, + Lisp_Object matchspec); +unsigned short glyph_height (Lisp_Object glyph, Lisp_Object domain, + Lisp_Object matchspec); Lisp_Object glyph_baseline (Lisp_Object glyph, Lisp_Object domain); Lisp_Object glyph_face (Lisp_Object glyph, Lisp_Object domain); int glyph_contrib_p (Lisp_Object glyph, Lisp_Object domain); Lisp_Object glyph_image_instance (Lisp_Object glyph, Lisp_Object domain, + Lisp_Object matchspec, Error_Behavior errb, int no_quit); void file_or_data_must_be_present (Lisp_Object instantiator); void data_must_be_present (Lisp_Object instantiator); ＠＠ -1046,14 +1105,8 ＠＠ Lisp_Object normalize_image_instantiator (Lisp_Object instantiator, Lisp_Object contype, Lisp_Object dest_mask); -void glyph_query_geometry (Lisp_Object glyph_or_image, int* width, int* height, - enum image_instance_geometry disp, - Lisp_Object domain); -void glyph_do_layout (Lisp_Object glyph_or_image, int width, int height, - int xoffset, int yoffset, - Lisp_Object domain); void query_string_geometry ( Lisp_Object string, Lisp_Object face, - int* width, int* height, int* descent, + int *width, int *height, int *descent, Lisp_Object domain); Lisp_Object query_string_font (Lisp_Object string, Lisp_Object face, Lisp_Object domain); ＠＠ -1068,13 +1121,8 ＠＠ struct glyph_cachel { Lisp_Object glyph; + Lisp_Object matchspec; - unsigned int dirty :1; /* I'm copying faces here. I'm not - sure why we need two dirty - flags. Maybe because an image - instance can be dirty and so we - need to frob this in the same way - as other image instance properties. */ unsigned int updated :1; unsigned short width; ＠＠ -1089,61 +1137,32 ＠＠ #define OCT_ESC_GLYPH_INDEX (glyph_index) 4 #define INVIS_GLYPH_INDEX (glyph_index) 5 -#ifdef ERROR_CHECK_GLYPHS +#define MAX_BUILTIN_GLYPH_INDEX INVIS_GLYPH_INDEX DECLARE_INLINE_HEADER ( int -GLYPH_CACHEL_WIDTH (struct window *window, int ind) +glyph_cachel_width (struct window *window, int ind) ) { int wid = Dynarr_atp (window->glyph_cachels, ind)->width; - assert (wid >= 0 && wid < 10000); - return wid; -} - -DECLARE_INLINE_HEADER ( -int -GLYPH_CACHEL_ASCENT (struct window *window, int ind) -) -{ - int wid = Dynarr_atp (window->glyph_cachels, ind)->ascent; - assert (wid >= 0 && wid < 10000); + glyph_checking_assert (wid >= 0 && wid < 10000); return wid; } DECLARE_INLINE_HEADER ( -int -GLYPH_CACHEL_DESCENT (struct window *window, int ind) +struct glyph_cachel * +glyph_cachel_from_index (struct window *window, int ind) ) { - int wid = Dynarr_atp (window->glyph_cachels, ind)->descent; - assert (wid >= 0 && wid < 10000); - return wid; + return Dynarr_atp (window->glyph_cachels, ind); } -#else /* not ERROR_CHECK_GLYPHS */ - -#define GLYPH_CACHEL_WIDTH(window, ind) \ - Dynarr_atp (window->glyph_cachels, ind)->width -#define GLYPH_CACHEL_ASCENT(window, ind) \ - Dynarr_atp (window->glyph_cachels, ind)->ascent -#define GLYPH_CACHEL_DESCENT(window, ind) \ - Dynarr_atp (window->glyph_cachels, ind)->descent - -#endif /* not ERROR_CHECK_GLYPHS */ - -#define GLYPH_CACHEL(window, ind) \ - Dynarr_atp (window->glyph_cachels, ind) -#define GLYPH_CACHEL_GLYPH(window, ind) \ - Dynarr_atp (window->glyph_cachels, ind)->glyph -#define GLYPH_CACHEL_DIRTYP(window, ind) \ - Dynarr_atp (window->glyph_cachels, ind)->dirty - void mark_glyph_cachels (glyph_cachel_dynarr *elements); void mark_glyph_cachels_as_not_updated (struct window *w); void mark_glyph_cachels_as_clean (struct window *w); void reset_glyph_cachels (struct window *w); -glyph_index get_glyph_cachel_index (struct window *w, Lisp_Object glyph); +void record_glyph_cachel (struct window *w, Lisp_Object glyph, + Lisp_Object matchspec); #ifdef MEMORY_USAGE_STATS int compute_glyph_cachel_usage (glyph_cachel_dynarr *glyph_cachels, ＠＠ -1159,23 +1178,22 ＠＠ Lisp_Object *, Lisp_Object *); /**************************************************************************** - * Subwindow Object * + * Subcontrols (Widgets and Subwindows) * ****************************************************************************/ -void unmap_subwindow (Lisp_Object subwindow); -void map_subwindow (Lisp_Object subwindow, int x, int y, +void unmap_subcontrol (Lisp_Object subcontrol); +void map_subcontrol (Lisp_Object subcontrol, int x, int y, struct display_glyph_area *dga); -int find_matching_subwindow (struct frame* f, int x, int y, int width, +int find_matching_subcontrol (struct frame *f, int x, int y, int width, int height); void redisplay_widget (Lisp_Object widget); void update_widget_instances (Lisp_Object frame); -void redisplay_subwindow (Lisp_Object subwindow); +void redisplay_subcontrol (Lisp_Object subcontrol); Lisp_Object image_instance_parent_glyph (struct Lisp_Image_Instance*); int image_instance_changed (Lisp_Object image); -void free_frame_subwindow_instances (struct frame* f); -void reset_frame_subwindow_instance_cache (struct frame* f); -int unmap_subwindow_instance_cache_mapper (Lisp_Object key, - Lisp_Object value, void* finalize); +void free_frame_subcontrols (struct frame *f); +void frame_unmap_all_subcontrols (struct frame *f); +void free_window_subcontrols (struct window *w); struct expose_ignore { ＠＠ -1184,7 +1202,7 ＠＠ struct expose_ignore *next; }; -int check_for_ignored_expose (struct frame* f, int x, int y, int width, +int check_for_ignored_expose (struct frame *f, int x, int y, int width, int height); extern int hold_ignored_expose_registration; 1.18.6.1 +6 -6 XEmacs/xemacs/src/gpmevent.c Index: gpmevent.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/gpmevent.c,v retrieving revision 1.18 retrieving revision 1.18.6.1 diff -u -r1.18 -r1.18.6.1 --- gpmevent.c 2004/09/20 19:19:47 1.18 +++ gpmevent.c 2005/02/16 00:43:27 1.18.6.1 ＠＠ -54,7 +54,7 ＠＠ extern void *gpm_stack; static int (*orig_event_pending_p) (int); -static void (*orig_next_event_cb) (Lisp_Event *); +static void (*orig_next_event) (Lisp_Event *); static Lisp_Object gpm_event_queue; static Lisp_Object gpm_event_queue_tail; ＠＠ -374,13 +374,13 ＠＠ EVENT_CHAIN_LOOP (event, gpm_event_queue) { - if (!user_p || command_event_p (event)) + if (!user_p || user_event_p (event)) return (1); } return (orig_event_pending_p (user_p)); } -static void gpm_next_event_cb (Lisp_Event *event) +static void gpm_next_event (Lisp_Event *event) { /* #### It would be nice to preserve some sort of ordering of the ** #### different types of events, but that would be quite a bit ＠＠ -443,7 +443,7 ＠＠ return; } - orig_next_event_cb (event); + orig_next_event (event); } static void hook_event_callbacks_once (void) ＠＠ -453,9 +453,9 ＠＠ if (!hooker) { orig_event_pending_p = event_stream->event_pending_p; - orig_next_event_cb = event_stream->next_event_cb; + orig_next_event = event_stream->next_event; event_stream->event_pending_p = gpm_event_pending_p; - event_stream->next_event_cb = gpm_next_event_cb; + event_stream->next_event = gpm_next_event; hooker = 1; } } 1.7.4.1 +16 -2 XEmacs/xemacs/src/gtk-glue.c Index: gtk-glue.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/gtk-glue.c,v retrieving revision 1.7 retrieving revision 1.7.4.1 diff -u -r1.7 -r1.7.4.1 --- gtk-glue.c 2005/01/24 23:33:59 1.7 +++ gtk-glue.c 2005/02/16 00:43:27 1.7.4.1 ＠＠ -1,3 +1,5 ＠＠ +/* !!#### This file is entirely non-Mule-ized. Major crash city. */ + GtkType GTK_TYPE_ARRAY = 0; GtkType GTK_TYPE_STRING_ARRAY = 0; GtkType GTK_TYPE_FLOAT_ARRAY = 0; ＠＠ -64,6 +66,7 ＠＠ while (!NILP (temp)) { + /* !!#### Warning non-Mule-ized. */ strings = g_list_append (strings, XSTRING_DATA (XCAR (temp))); temp = XCDR (temp); } ＠＠ -169,7 +172,8 ＠＠ if (arg->type == GTK_TYPE_STRING_ARRAY) { - FROB(gchar *, CHECK_STRING, (gchar*) XSTRING_DATA); + /* !!#### Warning non-Mule-ized. */ + FROB(gchar *, CHECK_STRING, (gchar *) XSTRING_DATA); } else if (arg->type == GTK_TYPE_FLOAT_ARRAY) { ＠＠ -228,7 +232,7 ＠＠ } static Lisp_Object -gdk_event_to_emacs_event(GdkEvent *ev) +gdk_event_to_emacs_event (GdkEvent *ev) { Lisp_Object event = Qnil; ＠＠ -241,6 +245,15 ＠＠ if (!gtk_event_to_emacs_event (NULL, ev, emacs_event)) { +#error please fix + /* Bill, I'm not sure what the purpose of this is but it isn't + going to work. The button/modifiers/x/y in misc-user were + only for drop events. No functions named `double-click' or + `triple-click' exist so this will cause errors, and misc-user + doesn't exist any more. Best just to let mouse.el handle + double/triple-clicking. --ben */ + +#if 0 /* We need to handle a few more cases than the normal event ** loop does. Mainly the double/triple click events. */ ＠＠ -257,6 +270,7 ＠＠ SET_EVENT_MISC_USER_FUNCTION (emacs_event, intern ("triple-click")); } else +#endif { Fdeallocate_event (event); event = Qnil; 1.14.6.1 +82 -82 XEmacs/xemacs/src/gtk-xemacs.c Index: gtk-xemacs.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/gtk-xemacs.c,v retrieving revision 1.14 retrieving revision 1.14.6.1 diff -u -r1.14 -r1.14.6.1 --- gtk-xemacs.c 2004/10/16 13:08:58 1.14 +++ gtk-xemacs.c 2005/02/16 00:43:28 1.14.6.1 ＠＠ -254,21 +254,21 ＠＠ static void gtk_xemacs_size_request (GtkWidget *widget, GtkRequisition *requisition) { - GtkXEmacs *x = GTK_XEMACS (widget); - struct frame *f = GTK_XEMACS_FRAME (x); - int width, height; - - if (f) - { - char_to_pixel_size (f, FRAME_WIDTH (f), FRAME_HEIGHT (f), - &width, &height); - requisition->width = width; - requisition->height = height; - } - else - { - parent_class->size_request (widget, requisition); - } + GtkXEmacs *x = GTK_XEMACS (widget); + struct frame *f = GTK_XEMACS_FRAME (x); + int width, height; + + if (f) + { + char_to_pixel_size (f, FRAME_WIDTH (f), FRAME_HEIGHT (f), + &width, &height); + requisition->width = width; + requisition->height = height; + } + else + { + parent_class->size_request (widget, requisition); + } } /* Assign a size and position to the child widgets. This differs from the ＠＠ -282,84 +282,84 ＠＠ static void gtk_xemacs_size_allocate (GtkWidget *widget, GtkAllocation *allocation) { - GtkXEmacs *x = GTK_XEMACS (widget); - GtkFixed *fixed = GTK_FIXED (widget); - struct frame *f = GTK_XEMACS_FRAME (x); - int columns, rows; - GList *children; - guint16 border_width; - - widget->allocation = *allocation; - if (GTK_WIDGET_REALIZED (widget)) - gdk_window_move_resize (widget->window, - allocation->x, - allocation->y, - allocation->width, - allocation->height); + GtkXEmacs *x = GTK_XEMACS (widget); + GtkFixed *fixed = GTK_FIXED (widget); + struct frame *f = GTK_XEMACS_FRAME (x); + int columns, rows; + GList *children; + guint16 border_width; + + widget->allocation = *allocation; + if (GTK_WIDGET_REALIZED (widget)) + gdk_window_move_resize (widget->window, + allocation->x, + allocation->y, + allocation->width, + allocation->height); - border_width = GTK_CONTAINER (fixed)->border_width; + border_width = GTK_CONTAINER (fixed)->border_width; - children = fixed->children; - while (children) - { - GtkFixedChild* child = (GtkFixedChild*) children->data; - children = children->next; + children = fixed->children; + while (children) + { + GtkFixedChild* child = (GtkFixedChild*) children->data; + children = children->next; - /* - Scrollbars are the only widget that is managed by GTK. See - comments in gtk_create_scrollbar_instance(). - */ - if (GTK_WIDGET_VISIBLE (child->widget) && - gtk_type_is_a(GTK_OBJECT_TYPE(child->widget), GTK_TYPE_SCROLLBAR)) - { - GtkAllocation child_allocation; - GtkRequisition child_requisition; - - gtk_widget_get_child_requisition (child->widget, &child_requisition); - child_allocation.x = child->x + border_width; - child_allocation.y = child->y + border_width; - child_allocation.width = child_requisition.width; - child_allocation.height = child_requisition.height; - gtk_widget_size_allocate (child->widget, &child_allocation); - } - } - - if (f) - { - f->pixwidth = allocation->width; - f->pixheight = allocation->height; - - pixel_to_char_size (f, - allocation->width, - allocation->height, &columns, &rows); + /* + Scrollbars are the only widget that is managed by GTK. See + comments in gtk_create_scrollbar_instance(). + */ + if (GTK_WIDGET_VISIBLE (child->widget) && + gtk_type_is_a (GTK_OBJECT_TYPE (child->widget), GTK_TYPE_SCROLLBAR)) + { + GtkAllocation child_allocation; + GtkRequisition child_requisition; - change_frame_size (f, rows, columns, 1); - } + gtk_widget_get_child_requisition (child->widget, &child_requisition); + child_allocation.x = child->x + border_width; + child_allocation.y = child->y + border_width; + child_allocation.width = child_requisition.width; + child_allocation.height = child_requisition.height; + gtk_widget_size_allocate (child->widget, &child_allocation); + } + } + + if (f) + { + f->pixwidth = allocation->width; + f->pixheight = allocation->height; + + pixel_to_char_size (f, + allocation->width, + allocation->height, &columns, &rows); + + change_frame_size (f, rows, columns, 1); + } } static void gtk_xemacs_paint (GtkWidget *widget, GdkRectangle *area) { - GtkXEmacs *x = GTK_XEMACS (widget); - struct frame *f = GTK_XEMACS_FRAME (x); + GtkXEmacs *x = GTK_XEMACS (widget); + struct frame *f = GTK_XEMACS_FRAME (x); - if (GTK_WIDGET_DRAWABLE (widget)) - redisplay_redraw_exposed_area (f, area->x, area->y, area->width, - area->height); + if (GTK_WIDGET_DRAWABLE (widget)) + redisplay_redraw_exposed_area (f, area->x, area->y, area->width, + area->height); } static void gtk_xemacs_draw (GtkWidget *widget, GdkRectangle *area) { - GtkFixed *fixed = GTK_FIXED (widget); - GtkFixedChild *child; - GdkRectangle child_area; - GList *children; - - /* I need to manually iterate over the children instead of just - chaining to parent_class->draw() because it calls - gtk_fixed_paint() directly, which clears the background window, - which causes A LOT of flashing. */ + GtkFixed *fixed = GTK_FIXED (widget); + GtkFixedChild *child; + GdkRectangle child_area; + GList *children; + + /* I need to manually iterate over the children instead of just + chaining to parent_class->draw() because it calls + gtk_fixed_paint() directly, which clears the background window, + which causes A LOT of flashing. */ if (GTK_WIDGET_DRAWABLE (widget)) { ＠＠ -395,9 +395,9 ＠＠ static gint gtk_xemacs_expose (GtkWidget *widget, GdkEventExpose *event) { - GtkXEmacs *x = GTK_XEMACS (widget); - struct frame *f = GTK_XEMACS_FRAME (x); - GdkRectangle *a = &event->area; + GtkXEmacs *x = GTK_XEMACS (widget); + struct frame *f = GTK_XEMACS_FRAME (x); + GdkRectangle *a = &event->area; if (GTK_WIDGET_DRAWABLE (widget)) { ＠＠ -406,7 +406,7 ＠＠ /* Now draw the actual frame data */ if (!check_for_ignored_expose (f, a->x, a->y, a->width, a->height) && - !find_matching_subwindow (f, a->x, a->y, a->width, a->height)) + !find_matching_subcontrol (f, a->x, a->y, a->width, a->height)) redisplay_redraw_exposed_area (f, a->x, a->y, a->width, a->height); return (TRUE); } 1.8.4.1 +0 -17 XEmacs/xemacs/src/gui-gtk.c Index: gui-gtk.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/gui-gtk.c,v retrieving revision 1.8 retrieving revision 1.8.4.1 diff -u -r1.8 -r1.8.4.1 --- gui-gtk.c 2005/02/03 16:30:37 1.8 +++ gui-gtk.c 2005/02/16 00:43:28 1.8.4.1 ＠＠ -77,9 +77,6 ＠＠ void syms_of_gui_gtk (void) { -#ifdef HAVE_POPUPS - DEFSYMBOL (Qmenu_no_selection_hook); -#endif } void ＠＠ -87,18 +84,4 ＠＠ { staticpro (&Vpopup_callbacks); Vpopup_callbacks = Qnil; -#ifdef HAVE_POPUPS - popup_up_p = 0; - -#if 0 - /* This DEFVAR_LISP is just for the benefit of make-docfile. */ - /* #### misnamed */ - DEFVAR_LISP ("menu-no-selection-hook", &Vmenu_no_selection_hook /* -Function or functions to call when a menu or dialog box is dismissed -without a selection having been made. -*/ ); -#endif - - Fset (Qmenu_no_selection_hook, Qnil); -#endif /* HAVE_POPUPS */ } 1.10.6.1 +20 -37 XEmacs/xemacs/src/gui-msw.c Index: gui-msw.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/gui-msw.c,v retrieving revision 1.10 retrieving revision 1.10.6.1 diff -u -r1.10 -r1.10.6.1 --- gui-msw.c 2004/11/04 23:06:34 1.10 +++ gui-msw.c 2005/02/16 00:43:29 1.10.6.1 ＠＠ -46,10 +46,8 ＠＠ LPARAM id) { /* Try to map the command id through the proper hash table */ - Lisp_Object callback, callback_ex, image_instance, frame, event; + Lisp_Object callback, gui, image_instance; - frame = wrap_frame (f); - image_instance = Fgethash (make_int_verify (id), FRAME_MSWINDOWS_WIDGET_HASH_TABLE1 (f), Qnil); /* It is possible for a widget action to cause it to get out of sync ＠＠ -57,42 +55,27 ＠＠ possibility. */ if (IMAGE_INSTANCEP (image_instance)) XIMAGE_INSTANCE_WIDGET_ACTION_OCCURRED (image_instance) = 1; - callback = Fgethash (make_int (id), - FRAME_MSWINDOWS_WIDGET_HASH_TABLE2 (f), Qnil); - callback_ex = Fgethash (make_int (id), - FRAME_MSWINDOWS_WIDGET_HASH_TABLE3 (f), Qnil); - - if (!NILP (callback_ex) && !UNBOUNDP (callback_ex)) - { - event = Fmake_event (Qnil, Qnil); - - XSET_EVENT_TYPE (event, misc_user_event); - XSET_EVENT_CHANNEL (event, frame); - XSET_EVENT_TIMESTAMP (event, GetTickCount()); - XSET_EVENT_MISC_USER_FUNCTION (event, Qeval); - XSET_EVENT_MISC_USER_OBJECT (event, - list4 (Qfuncall, callback_ex, image_instance, event)); - } - else if (NILP (callback) || UNBOUNDP (callback)) - return Qnil; else - { - Lisp_Object fn, arg; - - event = Fmake_event (Qnil, Qnil); - - get_gui_callback (callback, &fn, &arg); - XSET_EVENT_TYPE (event, misc_user_event); - XSET_EVENT_CHANNEL (event, frame); - XSET_EVENT_TIMESTAMP (event, GetTickCount()); - XSET_EVENT_MISC_USER_FUNCTION (event, fn); - XSET_EVENT_MISC_USER_OBJECT (event, arg); - } - - mswindows_enqueue_dispatch_event (event); + return Qnil; + gui = Fgethash (make_int (id), + FRAME_MSWINDOWS_WIDGET_HASH_TABLE2 (f), Qnil); + /* #### both of the hash tables are value-weak. since the gui items are + #### (or should be) pointed to by the image instance (in its + #### subcontrol-specific data), we should never hit this. if we do, we + #### need to be more clever with our hashing. */ + assert (GUI_ITEMP (gui)); + callback = XGUI_ITEM (gui)->callback; + if (NILP (callback) || UNBOUNDP (callback)) + return Qnil; + enqueue_activate_event (ACTIVATE_WIDGET_ACTION, image_instance, + XGUI_ITEM (gui)->name, callback); /* The result of this evaluation could cause other instances to change so - enqueue an update callback to check this. */ - enqueue_magic_eval_event (update_widget_instances, frame); + enqueue an update callback to check this. + + ^^#### Clearly this is wrong. When instances are changed, they should + automatically set the necessary dirty flags! There shouldn't be any + special-casing on callbacks! --ben */ + enqueue_magic_eval_event (update_widget_instances, wrap_frame (f)); return Qt; } 1.39.4.1 +65 -60 XEmacs/xemacs/src/gui-x.c Index: gui-x.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/gui-x.c,v retrieving revision 1.39 retrieving revision 1.39.4.1 diff -u -r1.39 -r1.39.4.1 --- gui-x.c 2005/02/03 16:30:37 1.39 +++ gui-x.c 2005/02/16 00:43:29 1.39.4.1 ＠＠ -1,6 +1,6 ＠＠ /* General GUI code -- X-specific. (menubars, scrollbars, toolbars, dialogs) Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995, 1996, 2000, 2001, 2002, 2003 Ben Wing. + Copyright (C) 1995, 1996, 2000, 2001, 2002, 2003, 2005 Ben Wing. Copyright (C) 1995 Sun Microsystems, Inc. Copyright (C) 1998 Free Software Foundation, Inc. ＠＠ -218,7 +218,9 ＠＠ } /* The following is actually called from somewhere within XtDispatchEvent(), - called from XtAppProcessEvent() in event-Xt.c. + called from XtAppProcessEvent() in event-Xt.c. CLIENT_DATA is -1 for + popup menu popped down with no selection, else a cons of one of + Qdialog, Qmenubar, or an image instance and a gui-item. Callback function for widgets and menus. */ ＠＠ -227,9 +229,9 ＠＠ popup_selection_callback (Widget widget, LWLIB_ID UNUSED (id), XtPointer client_data) { - Lisp_Object data, image_instance, callback, callback_ex; - Lisp_Object frame, event; - int update_subwindows_p = 0; + Lisp_Object data, image_instance, gui, callback; + Lisp_Object frame; + int update_subcontrols_p = 0; struct device *d = get_device_from_display (XtDisplay (widget)); struct frame *f = x_any_widget_or_parent_to_frame (d, widget); ＠＠ -257,65 +259,68 ＠＠ Faccept_process_output (Qnil, Qnil, Qnil); #endif - if (((EMACS_INT) client_data) == -1) - { - event = Fmake_event (Qnil, Qnil); + /* This is the timestamp used for asserting focus so we need to get an + up-to-date value event if no events have been dispatched to emacs + */ +#if defined(HAVE_MENUBARS) + DEVICE_X_MOUSE_TIMESTAMP (d) = x_focus_timestamp_really_sucks_fix_me_better; +#else + DEVICE_X_MOUSE_TIMESTAMP (d) = DEVICE_X_GLOBAL_MOUSE_TIMESTAMP (d); +#endif - XSET_EVENT_TYPE (event, misc_user_event); - XSET_EVENT_CHANNEL (event, frame); - XSET_EVENT_MISC_USER_FUNCTION (event, Qrun_hooks); - XSET_EVENT_MISC_USER_OBJECT (event, Qmenu_no_selection_hook); - } + if (((EMACS_INT) client_data) == -1) + enqueue_notify_event (NOTIFY_NO_MENU_SELECTION, frame); else { image_instance = XCAR (data); - callback = XCAR (XCDR (data)); - callback_ex = XCDR (XCDR (data)); - update_subwindows_p = 1; + gui = XCDR (data); + callback = XGUI_ITEM (gui)->callback; /* It is possible for a widget action to cause it to get out of sync with its instantiator. Thus it is necessary to signal this possibility. */ if (IMAGE_INSTANCEP (image_instance)) XIMAGE_INSTANCE_WIDGET_ACTION_OCCURRED (image_instance) = 1; - - if (!NILP (callback_ex) && !UNBOUNDP (callback_ex)) - { - event = Fmake_event (Qnil, Qnil); - XSET_EVENT_TYPE (event, misc_user_event); - XSET_EVENT_CHANNEL (event, frame); - XSET_EVENT_MISC_USER_FUNCTION (event, Qeval); - XSET_EVENT_MISC_USER_OBJECT (event, list4 (Qfuncall, callback_ex, image_instance, event)); - } - else if (NILP (callback) || UNBOUNDP (callback)) - event = Qnil; + if (NILP (callback) || UNBOUNDP (callback)) + update_subcontrols_p = 0; else { - Lisp_Object fn, arg; - - event = Fmake_event (Qnil, Qnil); - - get_gui_callback (callback, &fn, &arg); - XSET_EVENT_TYPE (event, misc_user_event); - XSET_EVENT_CHANNEL (event, frame); - XSET_EVENT_MISC_USER_FUNCTION (event, fn); - XSET_EVENT_MISC_USER_OBJECT (event, arg); + update_subcontrols_p = IMAGE_INSTANCEP (image_instance); + enqueue_activate_event + (IMAGE_INSTANCEP (image_instance) ? ACTIVATE_WIDGET_ACTION : + EQ (image_instance, Qmenubar) ? ACTIVATE_MENU_SELECTION : + EQ (image_instance, Qdialog) ? ACTIVATE_WIDGET_ACTION : + /* #### fix me fix me fix me! Toolbar events under X and + #### (maybe?) GTK are currently handled in Lisp using a + #### toolbar-keymap that handles button presses on the + #### toolbar. This is because (at least under X) the + #### toolbars are entirely generated inside of redisplay + #### with no toolkit support. We really need to make the + #### toolbars work in such a way that a single activate + #### event, type toolbar, gets generated; no string of + #### button1 events beforehand. This maybe can be handled + #### by way of key-translation-map. Or maybe, we need some + #### C support where, at the point that we look up stuff in + #### the toolbar map, instead of posting an event, we + #### directly call the toolbar event-handling code, which + #### can return a new event to be substituted or + #### nothing. [Hmm, this takes place at the same time as + #### key-translation-map and works similarly; maybe we could + #### use key-translation-map.] --ben */ + /* EQ (image_instance, Qtoolbar) ? ACTIVATE_TOOLBAR_SELECTION : */ + (ABORT (), (enum activate_event_type) -1), + IMAGE_INSTANCEP (image_instance) ? image_instance : frame, + XGUI_ITEM (gui)->name, callback); } } - /* This is the timestamp used for asserting focus so we need to get an - up-to-date value event if no events have been dispatched to emacs - */ -#ifdef HAVE_MENUBARS - DEVICE_X_MOUSE_TIMESTAMP (d) = x_focus_timestamp_really_sucks_fix_me_better; -#else - DEVICE_X_MOUSE_TIMESTAMP (d) = DEVICE_X_GLOBAL_MOUSE_TIMESTAMP (d); -#endif - if (!NILP (event)) - enqueue_dispatch_event (event); - /* The result of this evaluation could cause other instances to change so - enqueue an update callback to check this. */ - if (update_subwindows_p && !NILP (event)) + /* The result of this evaluation could cause other instances to change so + enqueue an update callback to check this. + + ^^#### Clearly this is wrong. When instances are changed, they should + automatically set the necessary dirty flags! There shouldn't be any + special-casing on callbacks! --ben */ + if (update_subcontrols_p) enqueue_magic_eval_event (update_widget_instances, frame); } ＠＠ -407,7 +412,7 ＠＠ int menu_entry_p, int accel_p) { /* This function cannot GC because GC is inhibited when it's called */ - Lisp_Gui_Item* pgui = 0; + Lisp_Gui_Item *pgui = 0; /* degenerate case */ if (STRINGP (gui_item)) ＠＠ -469,10 +474,10 ＠＠ wv_set_evalable_slot (wv->enabled, pgui->active); wv_set_evalable_slot (wv->selected, pgui->selected); - if (!NILP (pgui->callback) || !NILP (pgui->callback_ex)) - wv->call_data = LISP_TO_VOID (cons3 (gui_object_instance, - pgui->callback, - pgui->callback_ex)); + /* This gets marked because we store a handle to the lwlib data in + Vpopup_callbacks, and we retrieve the call data in mark_popup_data() */ + if (!NILP (pgui->callback)) + wv->call_data = LISP_TO_VOID (Fcons (gui_object_instance, gui_item)); if (no_keys_p #ifdef HAVE_MENUBARS ＠＠ -565,15 +570,15 ＠＠ static void gui_item_children_to_widget_values (Lisp_Object gui_object_instance, Lisp_Object items, - widget_value* parent, + widget_value *parent, int accel_p); static widget_value * gui_items_to_widget_values_1 (Lisp_Object gui_object_instance, - Lisp_Object items, widget_value* parent, - widget_value* prev, int accel_p) + Lisp_Object items, widget_value *parent, + widget_value *prev, int accel_p) { - widget_value* wv = 0; + widget_value *wv = 0; assert ((parent || prev) && !(parent && prev)); /* now walk the tree creating widget_values as appropriate */ ＠＠ -617,10 +622,10 ＠＠ static void gui_item_children_to_widget_values (Lisp_Object gui_object_instance, - Lisp_Object items, widget_value* parent, + Lisp_Object items, widget_value *parent, int accel_p) { - widget_value* wv = 0, *prev = 0; + widget_value *wv = 0, *prev = 0; Lisp_Object rest; CHECK_CONS (items); 1.29.6.1 +4 -50 XEmacs/xemacs/src/gui.c Index: gui.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/gui.c,v retrieving revision 1.29 retrieving revision 1.29.6.1 diff -u -r1.29 -r1.29.6.1 --- gui.c 2004/11/04 23:06:35 1.29 +++ gui.c 2005/02/16 00:43:29 1.29.6.1 ＠＠ -1,6 +1,6 ＠＠ /* Generic GUI code. (menubars, scrollbars, toolbars, dialogs) Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995, 1996, 2000, 2001, 2002, 2003 Ben Wing. + Copyright (C) 1995, 1996, 2000, 2001, 2002, 2003, 2005 Ben Wing. Copyright (C) 1995 Sun Microsystems, Inc. Copyright (C) 1998 Free Software Foundation, Inc. ＠＠ -75,42 +75,6 ＠＠ return (*p == '!' || *p == ':' || *p == '\0'); } -/* Massage DATA to find the correct function and argument. Used by - popup_selection_callback() and the msw code. */ -void -get_gui_callback (Lisp_Object data, Lisp_Object *fn, Lisp_Object *arg) -{ - if (EQ (data, Qquit)) - { - *fn = Qeval; - *arg = list3 (Qsignal, list2 (Qquote, Qquit), Qnil); - Vquit_flag = Qt; - } - else if (SYMBOLP (data) - || (COMPILED_FUNCTIONP (data) - && XCOMPILED_FUNCTION (data)->flags.interactivep) - || (CONSP (data) && (EQ (XCAR (data), Qlambda)) - && !NILP (Fassq (Qinteractive, Fcdr (Fcdr (data)))))) - { - *fn = Qcall_interactively; - *arg = data; - } - else if (CONSP (data)) - { - *fn = Qeval; - *arg = data; - } - else - { - *fn = Qeval; - *arg = list3 (Qsignal, - list2 (Qquote, Qerror), - list2 (Qquote, list2 (build_msg_string - ("illegal callback"), - data))); - } -} - /* * Add a value VAL associated with keyword KEY into PGUI_ITEM * structure. If KEY is not a keyword, or is an unknown keyword, then ＠＠ -153,7 +117,6 ＠＠ FROB (selected) FROB (keys) FROB (callback) - FROB (callback_ex) FROB (value) #undef FROB else if (EQ (key, Q_key_sequence)) ; /* ignored for FSF compatibility */ ＠＠ -181,7 +144,6 ＠＠ lp->name = Qnil; lp->callback = Qnil; - lp->callback_ex = Qnil; lp->suffix = Qnil; lp->active = Qt; lp->included = Qt; ＠＠ -358,8 +320,6 ＠＠ if (!NILP (pgui_item->callback)) Fplist_put (plist, Q_callback, pgui_item->callback); - if (!NILP (pgui_item->callback_ex)) - Fplist_put (plist, Q_callback_ex, pgui_item->callback_ex); if (!NILP (pgui_item->suffix)) Fplist_put (plist, Q_suffix, pgui_item->suffix); if (!NILP (pgui_item->active)) ＠＠ -560,11 +520,10 ＠＠ static const struct memory_description gui_item_description [] = { { XD_LISP_OBJECT, offsetof (struct Lisp_Gui_Item, name) }, { XD_LISP_OBJECT, offsetof (struct Lisp_Gui_Item, callback) }, - { XD_LISP_OBJECT, offsetof (struct Lisp_Gui_Item, callback_ex) }, + { XD_LISP_OBJECT, offsetof (struct Lisp_Gui_Item, config) }, { XD_LISP_OBJECT, offsetof (struct Lisp_Gui_Item, suffix) }, { XD_LISP_OBJECT, offsetof (struct Lisp_Gui_Item, active) }, { XD_LISP_OBJECT, offsetof (struct Lisp_Gui_Item, included) }, - { XD_LISP_OBJECT, offsetof (struct Lisp_Gui_Item, config) }, { XD_LISP_OBJECT, offsetof (struct Lisp_Gui_Item, filter) }, { XD_LISP_OBJECT, offsetof (struct Lisp_Gui_Item, style) }, { XD_LISP_OBJECT, offsetof (struct Lisp_Gui_Item, selected) }, ＠＠ -581,12 +540,10 ＠＠ mark_object (p->name); mark_object (p->callback); - mark_object (p->callback_ex); mark_object (p->config); mark_object (p->suffix); mark_object (p->active); mark_object (p->included); - mark_object (p->config); mark_object (p->filter); mark_object (p->style); mark_object (p->selected); ＠＠ -602,9 +559,8 ＠＠ { Lisp_Gui_Item *p = XGUI_ITEM (obj); - return HASH2 (HASH6 (internal_hash (p->name, depth + 1), + return HASH2 (HASH5 (internal_hash (p->name, depth + 1), internal_hash (p->callback, depth + 1), - internal_hash (p->callback_ex, depth + 1), internal_hash (p->suffix, depth + 1), internal_hash (p->active, depth + 1), internal_hash (p->included, depth + 1)), ＠＠ -652,8 +608,6 ＠＠ && gui_value_equal (p1->callback, p2->callback, depth + 1) && - gui_value_equal (p1->callback_ex, p2->callback_ex, depth + 1) - && EQ (p1->suffix, p2->suffix) && EQ (p1->active, p2->active) ＠＠ -708,7 +662,6 ＠＠ lp = XGUI_ITEM (ret); lp->name = g->name; lp->callback = g->callback; - lp->callback_ex = g->callback_ex; lp->suffix = g->suffix; lp->active = g->active; lp->included = g->included; ＠＠ -846,6 +799,7 ＠＠ void vars_of_gui (void) { + /* #### misnamed */ DEFVAR_LISP ("menu-no-selection-hook", &Vmenu_no_selection_hook /* Function or functions to call when a menu or dialog box is dismissed without a selection having been made. 1.18.6.1 +24 -30 XEmacs/xemacs/src/gui.h Index: gui.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/gui.h,v retrieving revision 1.18 retrieving revision 1.18.6.1 diff -u -r1.18 -r1.18.6.1 --- gui.h 2004/02/17 15:20:57 1.18 +++ gui.h 2005/02/16 00:43:29 1.18.6.1 ＠＠ -1,6 +1,6 ＠＠ /* Generic GUI code. (menubars, scrollbars, toolbars, dialogs) Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995, 1996, 2002 Ben Wing. + Copyright (C) 1995, 1996, 2002, 2005 Ben Wing. Copyright (C) 1995 Sun Microsystems, Inc. This file is part of XEmacs. ＠＠ -28,12 +28,32 ＠＠ #define INCLUDED_gui_h_ int separator_string_p (const Ibyte *s); -void get_gui_callback (Lisp_Object, Lisp_Object *, Lisp_Object *); int gui_item_equal_sans_selected (Lisp_Object obj1, Lisp_Object obj2, int depth); - - +int update_gui_item_keywords (Lisp_Object gui_item, Lisp_Object item); +Lisp_Object copy_gui_item (Lisp_Object gui_item); +Lisp_Object widget_gui_parse_item_keywords (Lisp_Object item); +int gui_item_add_keyval_pair (Lisp_Object gui_item, + Lisp_Object key, Lisp_Object val, + Error_Behavior errb); +Lisp_Object gui_parse_item_keywords (Lisp_Object item); +Lisp_Object gui_parse_item_keywords_no_errors (Lisp_Object item); +void gui_add_item_keywords_to_plist (Lisp_Object plist, Lisp_Object gui_item); +int gui_item_active_p (Lisp_Object); +int gui_item_selected_p (Lisp_Object); +Lisp_Object gui_item_list_find_selected (Lisp_Object gui_item_list); +int gui_item_included_p (Lisp_Object, Lisp_Object into); +Lisp_Object gui_item_accelerator (Lisp_Object gui_item); +Lisp_Object gui_name_accelerator (Lisp_Object name); +int gui_item_id_hash (Lisp_Object, Lisp_Object gui_item, int); +Lisp_Object gui_item_display_flush_left (Lisp_Object gui_item); +Lisp_Object gui_item_display_flush_right (Lisp_Object gui_item); +Lisp_Object allocate_gui_item (void); +void gui_item_init (Lisp_Object gui_item); +Lisp_Object parse_gui_item_tree_children (Lisp_Object list); +Lisp_Object copy_gui_item_tree (Lisp_Object arg); +extern Lisp_Object Qmenu_no_selection_hook, Qdelete_dialog_box_hook; extern int popup_up_p; /************************************************************************/ ＠＠ -47,7 +67,6 ＠＠ struct lcrecord_header header; Lisp_Object name; /* String */ Lisp_Object callback; /* Symbol or form */ - Lisp_Object callback_ex; /* Form taking context arguments */ Lisp_Object suffix; /* String */ Lisp_Object active; /* Form */ Lisp_Object included; /* Form */ ＠＠ -66,31 +85,6 ＠＠ #define GUI_ITEMP(x) RECORDP (x, gui_item) #define CHECK_GUI_ITEM(x) CHECK_RECORD (x, gui_item) #define CONCHECK_GUI_ITEM(x) CONCHECK_RECORD (x, gui_item) - -int update_gui_item_keywords (Lisp_Object gui_item, Lisp_Object item); -Lisp_Object copy_gui_item (Lisp_Object gui_item); -Lisp_Object widget_gui_parse_item_keywords (Lisp_Object item); -int gui_item_add_keyval_pair (Lisp_Object gui_item, - Lisp_Object key, Lisp_Object val, - Error_Behavior errb); -Lisp_Object gui_parse_item_keywords (Lisp_Object item); -Lisp_Object gui_parse_item_keywords_no_errors (Lisp_Object item); -void gui_add_item_keywords_to_plist (Lisp_Object plist, Lisp_Object gui_item); -int gui_item_active_p (Lisp_Object); -int gui_item_selected_p (Lisp_Object); -Lisp_Object gui_item_list_find_selected (Lisp_Object gui_item_list); -int gui_item_included_p (Lisp_Object, Lisp_Object into); -Lisp_Object gui_item_accelerator (Lisp_Object gui_item); -Lisp_Object gui_name_accelerator (Lisp_Object name); -int gui_item_id_hash (Lisp_Object, Lisp_Object gui_item, int); -Lisp_Object gui_item_display_flush_left (Lisp_Object gui_item); -Lisp_Object gui_item_display_flush_right (Lisp_Object gui_item); -Lisp_Object allocate_gui_item (void); -void gui_item_init (Lisp_Object gui_item); -Lisp_Object parse_gui_item_tree_children (Lisp_Object list); -Lisp_Object copy_gui_item_tree (Lisp_Object arg); - -extern Lisp_Object Qmenu_no_selection_hook, Qdelete_dialog_box_hook; /* this is mswindows biased but reasonably safe I think */ #define GUI_ITEM_ID_SLOTS 8 1.18.4.1 +30 -33 XEmacs/xemacs/src/gutter.c Index: gutter.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/gutter.c,v retrieving revision 1.18 retrieving revision 1.18.4.1 diff -u -r1.18 -r1.18.4.1 --- gutter.c 2005/01/24 23:33:59 1.18 +++ gutter.c 2005/02/16 00:43:30 1.18.4.1 ＠＠ -1,5 +1,6 ＠＠ /* Gutter implementation. Copyright (C) 1999, 2000 Andy Piper. + Copyright (C) 2002 Ben Wing. This file is part of XEmacs. ＠＠ -418,7 +419,7 ＠＠ fail because the findex for a particular face has changed. */ if (force || f->faces_changed || f->frame_changed || f->gutter_changed || f->glyphs_changed || - f->size_changed || f->subwindows_changed || + f->size_changed || f->subcontrols_changed || w->windows_changed || f->windows_structure_changed || cdla_len != Dynarr_length (ddla) || (f->extents_changed && w->gutter_extent_modiff[pos])) ＠＠ -434,7 +435,7 ＠＠ f->gutter_changed ? "f->gutter_changed" : f->glyphs_changed ? "f->glyphs_changed" : f->size_changed ? "f->size_changed" : - f->subwindows_changed ? "f->subwindows_changed" : + f->subcontrols_changed ? "f->subcontrols_changed" : w->windows_changed ? "w->windows_changed" : f->windows_structure_changed ? "f->windows_structure_changed" : cdla_len != Dynarr_length (ddla) ? "different display structures" : ＠＠ -624,7 +625,7 ＠＠ { if (f->faces_changed || f->frame_changed || f->gutter_changed || f->glyphs_changed || - f->size_changed || f->subwindows_changed || + f->size_changed || f->subcontrols_changed || f->windows_changed || f->windows_structure_changed || f->extents_changed || f->frame_layout_changed) { ＠＠ -1196,39 +1197,11 ＠＠ void vars_of_gutter (void) { + Lisp_Object fb; + staticpro (&Vdefault_gutter_position); Vdefault_gutter_position = Qtop; - Fprovide (Qgutter); -} - -void -specifier_type_create_gutter (void) -{ - INITIALIZE_SPECIFIER_TYPE (gutter, "gutter", "gutter-specifier-p"); - SPECIFIER_HAS_METHOD (gutter, validate); - SPECIFIER_HAS_METHOD (gutter, after_change); - - INITIALIZE_SPECIFIER_TYPE (gutter_size, "gutter-size", "gutter-size-specifier-p"); - SPECIFIER_HAS_METHOD (gutter_size, validate); - - INITIALIZE_SPECIFIER_TYPE (gutter_visible, "gutter-visible", "gutter-visible-specifier-p"); - SPECIFIER_HAS_METHOD (gutter_visible, validate); -} - -void -reinit_specifier_type_create_gutter (void) -{ - REINITIALIZE_SPECIFIER_TYPE (gutter); - REINITIALIZE_SPECIFIER_TYPE (gutter_size); - REINITIALIZE_SPECIFIER_TYPE (gutter_visible); -} - -void -specifier_vars_of_gutter (void) -{ - Lisp_Object fb; - DEFVAR_SPECIFIER ("default-gutter", &Vdefault_gutter /* Specifier for a fallback gutter. Use `set-specifier' to change this. ＠＠ -1655,4 +1628,28 ＠＠ set_specifier_fallback (Vgutter_visible_p[BOTTOM_GUTTER], fb); set_specifier_fallback (Vgutter_visible_p[LEFT_GUTTER], fb); set_specifier_fallback (Vgutter_visible_p[RIGHT_GUTTER], fb); + + Fprovide (Qgutter); +} + +void +specifier_type_create_gutter (void) +{ + INITIALIZE_SPECIFIER_TYPE (gutter, "gutter", "gutter-specifier-p"); + SPECIFIER_HAS_METHOD (gutter, validate); + SPECIFIER_HAS_METHOD (gutter, after_change); + + INITIALIZE_SPECIFIER_TYPE (gutter_size, "gutter-size", "gutter-size-specifier-p"); + SPECIFIER_HAS_METHOD (gutter_size, validate); + + INITIALIZE_SPECIFIER_TYPE (gutter_visible, "gutter-visible", "gutter-visible-specifier-p"); + SPECIFIER_HAS_METHOD (gutter_visible, validate); +} + +void +reinit_specifier_type_create_gutter (void) +{ + REINITIALIZE_SPECIFIER_TYPE (gutter); + REINITIALIZE_SPECIFIER_TYPE (gutter_size); + REINITIALIZE_SPECIFIER_TYPE (gutter_visible); } 1.13.4.1 +19 -19 XEmacs/xemacs/src/hash.c Index: hash.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/hash.c,v retrieving revision 1.13 retrieving revision 1.13.4.1 diff -u -r1.13 -r1.13.4.1 --- hash.c 2005/01/26 10:22:24 1.13 +++ hash.c 2005/02/16 00:43:30 1.13.4.1 ＠＠ -35,7 +35,7 ＠＠ #define KEYS_DIFFER_P(old, new, testfun) \ (((old) != (new)) && (!(testfun) || !(testfun) ((old),(new)))) -static void rehash (hentry *harray, struct hash_table *ht, Elemcount size); +static void rehash (bhentry *harray, struct hash_table *ht, Elemcount size); Hashcode memory_hash (const void *xv, Bytecount size) ＠＠ -129,7 +129,7 ＠＠ } else { - hentry *harray = hash_table->harray; + bhentry *harray = hash_table->harray; hash_table_test_function test_function = hash_table->test_function; Elemcount size = hash_table->size; Hashcode hcode_initial = ＠＠ -137,7 +137,7 ＠＠ hash_table->hash_function (key) : (Hashcode) key; Elemcount hcode = (Elemcount) (hcode_initial % size); - hentry *e = &harray [hcode]; + bhentry *e = &harray [hcode]; const void *e_key = e->key; if (e_key ? ＠＠ -165,7 +165,7 ＠＠ void clrhash (struct hash_table *hash_table) { - memset (hash_table->harray, 0, sizeof (hentry) * hash_table->size); + memset (hash_table->harray, 0, sizeof (bhentry) * hash_table->size); hash_table->zero_entry = 0; hash_table->zero_set = 0; hash_table->fullness = 0; ＠＠ -183,7 +183,7 ＠＠ { struct hash_table *hash_table = xnew_and_zero (struct hash_table); hash_table->size = hash_table_size (COMFORTABLE_SIZE (size)); - hash_table->harray = xnew_array (hentry, hash_table->size); + hash_table->harray = xnew_array (bhentry, hash_table->size); clrhash (hash_table); return hash_table; } ＠＠ -209,10 +209,10 ＠＠ grow_hash_table (struct hash_table *hash_table, Elemcount new_size) { Elemcount old_size = hash_table->size; - hentry *old_harray = hash_table->harray; + bhentry *old_harray = hash_table->harray; hash_table->size = hash_table_size (new_size); - hash_table->harray = xnew_array (hentry, hash_table->size); + hash_table->harray = xnew_array (bhentry, hash_table->size); /* do the rehash on the "grown" table */ { ＠＠ -248,7 +248,7 ＠＠ { hash_table_test_function test_function = hash_table->test_function; Elemcount size = hash_table->size; - hentry *harray = hash_table->harray; + bhentry *harray = hash_table->harray; Hashcode hcode_initial = hash_table->hash_function ? hash_table->hash_function (key) : ＠＠ -276,7 +276,7 ＠＠ then delete it. */ if (!e_key && oldcontents == NULL_ENTRY) { - hentry *e; + bhentry *e; do { ＠＠ -295,7 +295,7 ＠＠ } } - /* only increment the fullness when we used up a new hentry */ + /* only increment the fullness when we used up a new bhentry */ if (!e_key || KEYS_DIFFER_P (e_key, key, test_function)) { Elemcount comfortable_size = COMFORTABLE_SIZE (++(hash_table->fullness)); ＠＠ -306,10 +306,10 ＠＠ } static void -rehash (hentry *harray, struct hash_table *hash_table, Elemcount size) +rehash (bhentry *harray, struct hash_table *hash_table, Elemcount size) { - hentry *limit = harray + size; - hentry *e; + bhentry *limit = harray + size; + bhentry *e; for (e = harray; e < limit; e++) { if (e->key) ＠＠ -327,7 +327,7 ＠＠ } else { - hentry *harray = hash_table->harray; + bhentry *harray = hash_table->harray; hash_table_test_function test_function = hash_table->test_function; Elemcount size = hash_table->size; Hashcode hcode_initial = ＠＠ -335,7 +335,7 ＠＠ (hash_table->hash_function (key)) : ((Hashcode) key); Elemcount hcode = (Elemcount) (hcode_initial % size); - hentry *e = &harray [hcode]; + bhentry *e = &harray [hcode]; const void *e_key = e->key; if (e_key ? ＠＠ -366,8 +366,8 ＠＠ void maphash (maphash_function mf, struct hash_table *hash_table, void *arg) { - hentry *e; - hentry *limit; + bhentry *e; + bhentry *limit; if (hash_table->zero_set) { ＠＠ -385,8 +385,8 ＠＠ void map_remhash (remhash_predicate predicate, struct hash_table *hash_table, void *arg) { - hentry *e; - hentry *limit; + bhentry *e; + bhentry *limit; if (hash_table->zero_set && predicate (0, hash_table->zero_entry, arg)) { 1.10.4.1 +4 -3 XEmacs/xemacs/src/hash.h Index: hash.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/hash.h,v retrieving revision 1.10 retrieving revision 1.10.4.1 diff -u -r1.10 -r1.10.4.1 --- hash.h 2005/01/26 10:22:25 1.10 +++ hash.h 2005/02/16 00:43:30 1.10.4.1 ＠＠ -25,14 +25,14 ＠＠ { const void *key; void *contents; -} hentry; +} bhentry; typedef int (*hash_table_test_function) (const void *, const void *); typedef Hashcode (*hash_table_hash_function) (const void *); struct hash_table { - hentry *harray; + bhentry *harray; long zero_set; void *zero_entry; Elemcount size; /* size of the hasharray */ ＠＠ -59,7 +59,8 ＠＠ /* Free HASH-TABLE and its substructures */ void free_hash_table (struct hash_table *hash_table); -/* Returns a hentry whose key is 0 if the entry does not exist in HASH-TABLE */ +/* Returns a bhentry whose key is 0 if the entry does not exist in + HASH-TABLE */ const void *gethash (const void *key, struct hash_table *hash_table, const void **ret_value); 1.20.4.1 +20 -20 XEmacs/xemacs/src/indent.c Index: indent.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/indent.c,v retrieving revision 1.20 retrieving revision 1.20.4.1 diff -u -r1.20 -r1.20.4.1 --- indent.c 2005/01/26 05:11:12 1.20 +++ indent.c 2005/02/16 00:43:31 1.20.4.1 ＠＠ -124,14 +124,17 ＠＠ last_known_column_point = -1; } +/* Works for buffers or strings. TAB_WIDTH should be XINT (buffer->tab_width) + for buffers. CUR_COL is only for buffers. */ + int -column_at_point (struct buffer *buf, Charbpos init_pos, int cur_col) +column_at_point (Lisp_Object textobj, Charxpos init_pos, int tab_width, + int cur_col) { int col; int tab_seen; - int tab_width = XINT (buf->tab_width); int post_tab; - Charbpos pos = init_pos; + Charxpos pos = init_pos; Ichar c; if (tab_width <= 0 || tab_width > 1000) tab_width = 8; ＠＠ -139,11 +142,11 ＠＠ while (1) { - if (pos <= BUF_BEGV (buf)) + if (pos <= textobj_accessible_begin_char (textobj)) break; pos--; - c = BUF_FETCH_CHAR (buf, pos); + c = textobj_ichar_at_char (textobj, pos); if (c == '\t') { if (tab_seen) ＠＠ -154,7 +157,9 ＠＠ tab_seen = 1; } else if (c == '\n' || - (EQ (buf->selective_display, Qt) && c == '\r')) + (BUFFERP (textobj) + && EQ (XBUFFER (textobj)->selective_display, Qt) + && c == '\r')) break; else { ＠＠ -163,8 +168,8 ＠＠ We need to do similar. */ #if 0 displayed_glyphs = glyphs_from_charbpos (sel_frame, buf, - XWINDOW (selected_window), - pos, dp, 0, col, 0, 0, 0); + XWINDOW (selected_window), + pos, dp, 0, col, 0, 0, 0); col += (displayed_glyphs->columns - (displayed_glyphs->begin_columns + displayed_glyphs->end_columns)); ＠＠ -186,10 +191,10 ＠＠ if (cur_col) { - last_known_column_buffer = buf; + last_known_column_buffer = XBUFFER (textobj); last_known_column = col; last_known_column_point = init_pos; - last_known_column_modified = BUF_MODIFF (buf); + last_known_column_modified = BUF_MODIFF (XBUFFER (textobj)); } return col; ＠＠ -213,7 +218,7 ＠＠ break; pos--; - c = string_ichar (s, pos); + c = string_ichar_at (s, pos); if (c == '\t') { if (tab_seen) ＠＠ -233,12 +238,6 ＠＠ #endif /* MULE */ } - if (tab_seen) - { - col = ((col + tab_width) / tab_width) * tab_width; - col += post_tab; - } - return col; } ＠＠ -250,7 +249,8 ＠＠ && BUF_MODIFF (buf) == last_known_column_modified) return last_known_column; - return column_at_point (buf, BUF_PT (buf), 1); + return column_at_point (wrap_buffer (buf), BUF_PT (buf), + XINT (buf->tab_width), 1); } DEFUN ("current-column", Fcurrent_column, 0, 1, 0, /* ＠＠ -352,7 +352,7 ＠＠ tab_width = 8; while (byte_pos < byte_end && - (c = BYTE_BUF_FETCH_CHAR (b, byte_pos), + (c = BYTE_BUF_ICHAR_AT (b, byte_pos), (c == '\t' ? (col += tab_width - col % tab_width) : (c == ' ' ? ++col : 0)))) ＠＠ -431,7 +431,7 ＠＠ while (col < goal && pos < end) { - c = BUF_FETCH_CHAR (buf, pos); + c = BUF_ICHAR_AT (buf, pos); if (c == '\n') break; if (c == '\r' && EQ (buf->selective_display, Qt)) 1.34.4.1 +3 -3 XEmacs/xemacs/src/insdel.c Index: insdel.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/insdel.c,v retrieving revision 1.34 retrieving revision 1.34.4.1 diff -u -r1.34 -r1.34.4.1 --- insdel.c 2005/01/24 23:33:59 1.34 +++ insdel.c 2005/02/16 00:43:31 1.34.4.1 ＠＠ -1453,7 +1453,7 ＠＠ for (i = byte_from; i < byte_to; i = next_bytebpos (buf, i)) { - Ichar ch = BYTE_BUF_FETCH_CHAR (buf, i); + Ichar ch = BYTE_BUF_ICHAR_AT (buf, i); if (ichar_ascii_p (ch)) buf->text->num_ascii_chars--; if (ichar_8_bit_fixed_p (ch, wrap_buffer (buf))) ＠＠ -1579,7 +1579,7 ＠＠ newlen = set_itext_ichar_fmt (newstr, ch, BUF_FORMAT (buf), wrap_buffer (buf)); - oldch = BUF_FETCH_CHAR (buf, pos); + oldch = BUF_ICHAR_AT (buf, pos); if (ichar_fits_in_format (ch, BUF_FORMAT (buf), wrap_buffer (buf)) && newlen == ichar_len_fmt (oldch, BUF_FORMAT (buf))) { ＠＠ -1604,7 +1604,7 ＠＠ /* no more characters in buffer! */ return; - if (BUF_FETCH_CHAR (buf, pos) == '\n') + if (BUF_ICHAR_AT (buf, pos) == '\n') { MAP_INDIRECT_BUFFERS (buf, mbuf, bufcons) { 1.14.4.1 +2 -2 XEmacs/xemacs/src/intl-win32.c Index: intl-win32.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/intl-win32.c,v retrieving revision 1.14 retrieving revision 1.14.4.1 diff -u -r1.14 -r1.14.4.1 --- intl-win32.c 2005/01/24 23:34:00 1.14 +++ intl-win32.c 2005/02/16 00:43:32 1.14.4.1 ＠＠ -2315,10 +2315,10 ＠＠ { #ifdef MULE Vmswindows_charset_code_page_table = - make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (50, hash_table_non_weak, HASH_TABLE_EQ); staticpro (&Vmswindows_charset_code_page_table); Vmswindows_charset_registry_table = - make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (50, hash_table_non_weak, HASH_TABLE_EQ); staticpro (&Vmswindows_charset_registry_table); #endif /* MULE */ } 1.54.4.1 +37 -20 XEmacs/xemacs/src/keymap.c Index: keymap.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/keymap.c,v retrieving revision 1.54 retrieving revision 1.54.4.1 diff -u -r1.54 -r1.54.4.1 --- keymap.c 2005/01/24 23:34:01 1.54 +++ keymap.c 2005/02/16 00:43:33 1.54.4.1 ＠＠ -222,6 +222,8 ＠＠ Lisp_Object Qbutton0up, Qbutton1up, Qbutton2up, Qbutton3up; Lisp_Object Qbutton4up, Qbutton5up, Qbutton6up, Qbutton7up; +Lisp_Object Qactivate_event; + Lisp_Object Qmenu_selection; /* Emacs compatibility */ Lisp_Object Qdown_mouse_1, Qmouse_1; ＠＠ -480,7 +482,7 ＠＠ if (SYMBOLP (keysym) && string_char_length (XSYMBOL (keysym)->name) == 1) { Lisp_Object i_fart_on_gcc = - make_char (string_ichar (XSYMBOL (keysym)->name, 0)); + make_char (string_ichar_at (XSYMBOL (keysym)->name, 0)); keysym = i_fart_on_gcc; } ＠＠ -656,7 +658,7 ＠＠ /* If the keysym is a one-character symbol, use the char code instead. */ if (SYMBOLP (keysym) && string_char_length (XSYMBOL (keysym)->name) == 1) - keysym = make_char (string_ichar (XSYMBOL (keysym)->name, 0)); + keysym = make_char (string_ichar_at (XSYMBOL (keysym)->name, 0)); if (modifiers & XEMACS_MOD_META) /* Utterly hateful ESC lossage */ { ＠＠ -771,11 +773,11 ＠＠ if (size != 0) /* hack for copy-keymap */ { keymap->table = - make_lisp_hash_table (size, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (size, hash_table_non_weak, HASH_TABLE_EQ); /* Inverse table is often less dense because of duplicate key-bindings. If not, it will grow anyway. */ keymap->inverse_table = - make_lisp_hash_table (size * 3 / 4, HASH_TABLE_NON_WEAK, + make_lisp_hash_table (size * 3 / 4, hash_table_non_weak, HASH_TABLE_EQ); } return result; ＠＠ -1268,7 +1270,7 ＠＠ if (string_char_length (XSYMBOL (*keysym)->name) == 1) { Lisp_Object ream_gcc_up_the_ass = - make_char (string_ichar (XSYMBOL (*keysym)->name, 0)); + make_char (string_ichar_at (XSYMBOL (*keysym)->name, 0)); *keysym = ream_gcc_up_the_ass; goto fixnum_keysym; } ＠＠ -1459,6 +1461,20 ＠＠ SET_KEY_DATA_MODIFIERS (returned_value, XEVENT_BUTTON_MODIFIERS (spec)); break; } + + /* This is mainly here so that we can run activate events through + key lookup, and have the default value returned when necessary + -- this is needed to get C-u <menu-selection> working because + of the complexities of universal-argument-other-key; however, + this also provides a mechanism of intercepting activate events + in keymaps. */ + case activate_event: + { + returned_value->keysym = Qactivate_event; + returned_value->modifiers = 0; + break; + } + default: wtaerror ("unable to bind this type of event", spec); } ＠＠ -1527,18 +1543,18 ＠＠ /* #### where the hell does this come from? */ EQ (XCAR (list), Qmenu_selection)) { - Lisp_Object fn, arg; + Lisp_Object arg; if (! NILP (Fcdr (Fcdr (list)))) invalid_argument ("Invalid menu event desc", list); arg = Fcar (Fcdr (list)); - if (SYMBOLP (arg)) - fn = Qcall_interactively; - else - fn = Qeval; - XSET_EVENT_TYPE (event, misc_user_event); - XSET_EVENT_CHANNEL (event, wrap_frame (selected_frame ())); - XSET_EVENT_MISC_USER_FUNCTION (event, fn); - XSET_EVENT_MISC_USER_OBJECT (event, arg); + XEVENT (event)->channel = wrap_frame (selected_frame ()); + XSET_EVENT_TYPE (event, activate_event); + XSET_EVENT_TIMESTAMP + (event, + current_time_from_event_channel_or_else (XEVENT (event)->channel)); + XSET_EVENT_ACTIVATE_TYPE (event, ACTIVATE_MENU_SELECTION); + XSET_EVENT_ACTIVATE_TEXT (event, Qnil); + XSET_EVENT_ACTIVATE_CALLBACK (event, arg); return; } ＠＠ -1938,7 +1954,7 ＠＠ Lisp_Key_Data raw_key1; Lisp_Key_Data raw_key2; if (STRINGP (keys)) - c = make_char (string_ichar (keys, idx)); + c = make_char (string_ichar_at (keys, idx)); else c = XVECTOR_DATA (keys) [idx]; ＠＠ -2264,7 +2280,7 ＠＠ for (i = 0; i < length; i++) { - Ichar n = string_ichar (keys, i); + Ichar n = string_ichar_at (keys, i); define_key_parser (make_char (n), &(raw_keys[i])); } return raw_lookup_key (keymap, raw_keys, length, 0, ＠＠ -3279,7 +3295,7 ＠＠ { Lisp_Object s2 = Fsingle_key_description (STRINGP (keys) - ? make_char (string_ichar (keys, i)) + ? make_char (string_ichar_at (keys, i)) : XVECTOR_DATA (keys)[i]); if (i == 0) ＠＠ -3317,11 +3333,11 ＠＠ CHECK_CHAR_COERCE_INT (key); character_to_event (XCHAR (key), XEVENT (event), XCONSOLE (Vselected_console), 0, 1); - format_event_object (buf, event, 1); + format_event_object (buf, event, 0); Fdeallocate_event (event); } else - format_event_object (buf, key, 1); + format_event_object (buf, key, 0); str = eimake_string (buf); eifree (buf); return str; ＠＠ -3565,7 +3581,7 ＠＠ { XSET_EVENT_KEY_KEYSYM (event, keys[i].keysym); XSET_EVENT_KEY_MODIFIERS (event, KEY_DATA_MODIFIERS (&keys[i])); - format_event_object (buf, event, 1); + format_event_object (buf, event, 0); if (i < count - 1) eicat_ascii (buf, " "); } ＠＠ -4381,6 +4397,7 ＠＠ DEFSYMBOL (Qdown_mouse_5); DEFSYMBOL (Qdown_mouse_6); DEFSYMBOL (Qdown_mouse_7); + DEFSYMBOL (Qactivate_event); DEFSYMBOL (Qmenu_selection); DEFSYMBOL (QLFD); DEFSYMBOL (QTAB); 1.124.4.1 +486 -111 XEmacs/xemacs/src/lisp.h Index: lisp.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/lisp.h,v retrieving revision 1.124 retrieving revision 1.124.4.1 diff -u -r1.124 -r1.124.4.1 --- lisp.h 2005/02/03 16:30:37 1.124 +++ lisp.h 2005/02/16 00:43:34 1.124.4.1 ＠＠ -122,16 +122,38 ＠＠ #define ERROR_CHECK_TRAPPING_PROBLEMS #endif -#ifdef ERROR_CHECK_TYPES -#define type_checking_assert(assertion) assert (assertion) -#define type_checking_assert_at_line(assertion, file, line) \ +#ifdef ERROR_CHECK_BYTE_CODE +#define byte_code_checking_assert(assertion) assert (assertion) +#define byte_code_checking_assert_at_line(assertion, file, line) \ assert_at_line (assertion, file, line) -#define type_checking_assert_with_message(assertion, msg) \ +#define byte_code_checking_assert_with_message(assertion, msg) \ assert_with_message (assertion, msg) #else -#define type_checking_assert(assertion) -#define type_checking_assert_at_line(assertion, file, line) -#define type_checking_assert_with_message(assertion, msg) +#define byte_code_checking_assert(assertion) +#define byte_code_checking_assert_at_line(assertion, file, line) +#define byte_code_checking_assert_with_message(assertion, msg) +#endif +#ifdef ERROR_CHECK_DISPLAY +#define display_checking_assert(assertion) assert (assertion) +#define display_checking_assert_at_line(assertion, file, line) \ + assert_at_line (assertion, file, line) +#define display_checking_assert_with_message(assertion, msg) \ + assert_with_message (assertion, msg) +#else +#define display_checking_assert(assertion) +#define display_checking_assert_at_line(assertion, file, line) +#define display_checking_assert_with_message(assertion, msg) +#endif +#ifdef ERROR_CHECK_EXTENTS +#define extent_checking_assert(assertion) assert (assertion) +#define extent_checking_assert_at_line(assertion, file, line) \ + assert_at_line (assertion, file, line) +#define extent_checking_assert_with_message(assertion, msg) \ + assert_with_message (assertion, msg) +#else +#define extent_checking_assert(assertion) +#define extent_checking_assert_at_line(assertion, file, line) +#define extent_checking_assert_with_message(assertion, msg) #endif #ifdef ERROR_CHECK_GC #define gc_checking_assert(assertion) assert (assertion) ＠＠ -144,6 +166,39 ＠＠ #define gc_checking_assert_at_line(assertion, file, line) #define gc_checking_assert_with_message(assertion, msg) #endif +#ifdef ERROR_CHECK_GLYPH +#define glyph_checking_assert(assertion) assert (assertion) +#define glyph_checking_assert_at_line(assertion, file, line) \ + assert_at_line (assertion, file, line) +#define glyph_checking_assert_with_message(assertion, msg) \ + assert_with_message (assertion, msg) +#else +#define glyph_checking_assert(assertion) +#define glyph_checking_assert_at_line(assertion, file, line) +#define glyph_checking_assert_with_message(assertion, msg) +#endif +#ifdef ERROR_CHECK_MALLOC +#define malloc_checking_assert(assertion) assert (assertion) +#define malloc_checking_assert_at_line(assertion, file, line) \ + assert_at_line (assertion, file, line) +#define malloc_checking_assert_with_message(assertion, msg) \ + assert_with_message (assertion, msg) +#else +#define malloc_checking_assert(assertion) +#define malloc_checking_assert_at_line(assertion, file, line) +#define malloc_checking_assert_with_message(assertion, msg) +#endif +#ifdef ERROR_CHECK_STRUCTURES +#define structure_checking_assert(assertion) assert (assertion) +#define structure_checking_assert_at_line(assertion, file, line) \ + assert_at_line (assertion, file, line) +#define structure_checking_assert_with_message(assertion, msg) \ + assert_with_message (assertion, msg) +#else +#define structure_checking_assert(assertion) +#define structure_checking_assert_at_line(assertion, file, line) +#define structure_checking_assert_with_message(assertion, msg) +#endif #ifdef ERROR_CHECK_TEXT #define text_checking_assert(assertion) assert (assertion) #define text_checking_assert_at_line(assertion, file, line) \ ＠＠ -166,6 +221,17 ＠＠ #define trapping_problems_checking_assert_at_line(assertion, file, line) #define trapping_problems_checking_assert_with_message(assertion, msg) #endif +#ifdef ERROR_CHECK_TYPES +#define type_checking_assert(assertion) assert (assertion) +#define type_checking_assert_at_line(assertion, file, line) \ + assert_at_line (assertion, file, line) +#define type_checking_assert_with_message(assertion, msg) \ + assert_with_message (assertion, msg) +#else +#define type_checking_assert(assertion) +#define type_checking_assert_at_line(assertion, file, line) +#define type_checking_assert_with_message(assertion, msg) +#endif /************************************************************************/ /** Definitions of basic types **/ ＠＠ -949,6 +1015,23 ＠＠ /* Booleans */ typedef int Boolint; +#ifdef HAVE_INTTYPES_H +#include <inttypes.h> +#elif SIZEOF_VOID_P == SIZEOF_INT +typedef int intptr_t; +typedef unsigned int uintptr_t; +#elif SIZEOF_VOID_P == SIZEOF_LONG +typedef long intptr_t; +typedef unsigned long uintptr_t; +#elif defined(SIZEOF_LONG_LONG) && SIZEOF_VOID_P == SIZEOF_LONG_LONG +typedef long long intptr_t; +typedef unsigned long long uintptr_t; +#else +/* Just pray. May break, may not. */ +typedef long intptr_t; +typedef unsigned long uintptr_t; +#endif + /* ------------------------ basic compiler defines ------------------- */ #include "compiler.h" ＠＠ -1057,6 +1140,15 ＠＠ # define assert_at_line(x, file, line) assert (x) #endif +/* #### + Why the hell do we do this??????????????????????????????? */ +/*#ifdef DEBUG_XEMACS*/ +#define REGISTER +#define register +/*#else*/ +/*#define REGISTER register*/ +/*#endif*/ + /************************************************************************/ /** Memory allocation **/ /************************************************************************/ ＠＠ -1440,6 +1532,7 ＠＠ struct display_line; struct display_glyph_area; struct display_box; +struct rune; struct redisplay_info; struct window_mirror; struct scrollbar_instance; ＠＠ -1663,7 +1756,7 ＠＠ #define XPNTR(x) ((void *) XPNTRVAL(x)) /* WARNING WARNING WARNING. You must ensure on your own that proper - GC protection is provided for the elements in this array. */ + GC protection is provided for the elements in these Dynarrs. */ typedef struct { Dynarr_declare (Lisp_Object); ＠＠ -1674,6 +1767,19 ＠＠ Dynarr_declare (Lisp_Object *); } Lisp_Object_ptr_dynarr; +/* Used for keeping track of key/value pairs. Used in elhash.c, extents.c, + and funcalling primitives with keyword args. */ +typedef struct +{ + Lisp_Object key, value; +} Lisp_Object_pair; + +typedef struct +{ + Dynarr_declare (Lisp_Object_pair); +} Lisp_Object_pair_dynarr; + + /* Close your eyes now lest you vomit or spontaneously combust ... */ #define HACKEQ_UNSAFE(obj1, obj2) \ ＠＠ -2459,7 +2565,7 ＠＠ }; #define SYMBOL_IS_KEYWORD(sym) \ - ((string_byte (symbol_name (XSYMBOL (sym)), 0) == ':') \ + ((string_byte_at (symbol_name (XSYMBOL (sym)), 0) == ':') \ && EQ (sym, oblookup (Vobarray, \ XSTRING_DATA (symbol_name (XSYMBOL (sym))), \ XSTRING_LENGTH (symbol_name (XSYMBOL (sym)))))) ＠＠ -2485,36 +2591,6 ＠＠ #define XSYMBOL_PLIST(s) (XSYMBOL (s)->plist) -/*------------------------------- subr ---------------------------------*/ - -/* A function that takes no arguments and returns a Lisp_Object. - We could define such types for n arguments, if needed. */ -typedef Lisp_Object (*lisp_fn_t) (void); - -struct Lisp_Subr -{ - struct lrecord_header lheader; - short min_args; - short max_args; - const char *prompt; - const char *doc; - const char *name; - lisp_fn_t subr_fn; -}; -typedef struct Lisp_Subr Lisp_Subr; - -DECLARE_LRECORD (subr, Lisp_Subr); -#define XSUBR(x) XRECORD (x, subr, Lisp_Subr) -#define wrap_subr(p) wrap_record (p, subr) -#define SUBRP(x) RECORDP (x, subr) -#define CHECK_SUBR(x) CHECK_RECORD (x, subr) -#define CONCHECK_SUBR(x) CONCHECK_RECORD (x, subr) - -#define subr_function(subr) ((subr)->subr_fn) -#define SUBR_FUNCTION(subr,max_args) \ - ((Lisp_Object (*) (EXFUN_##max_args)) (subr)->subr_fn) -#define subr_name(subr) ((subr)->name) - /*------------------------------ marker --------------------------------*/ ＠＠ -2889,6 +2965,50 ＠＠ /* Definitions of primitive Lisp functions and variables */ /************************************************************************/ +/* A function that takes no arguments and returns a Lisp_Object. + We could define such types for n arguments, if needed. */ +typedef Lisp_Object (*lisp_fn_t) (void); + +#define KEYWORD_ALLOW_OTHER 1 +#define KEYWORD_DEFAULT_UNBOUND 2 + +struct Lisp_Subr +{ + struct lrecord_header lheader; + short min_args; + short max_args; /* 0 - SUBR_MAX_ARGS for a normal subr; or MANY (-1) or + UNEVALLED (-2), or <= KEYWORD_NEGATIVE_ARG_CONVERTER (-3) + if the subr allows keywords, in which case the actual + value for max_args (which does not include keywords) + is KEYWORD_NEGATIVE_ARG_CONVERTER - max_args. (The + reason for this multiplexing is to save some checks + in Ffuncall() etc.; #### perhaps not worth it.) */ + unsigned short num_keywords; + short keyword_props; /* KEYWORD_ALLOW_OTHER, KEYWORD_DEFAULT_UNBOUND. */ + const char **keywords; /* array of keyword strings; used to initialize + the following */ + Lisp_Object *keyword_syms; /* array of keyword symbols; staticpro()'d */ + const char *prompt; + const char *doc; + const char *name; + lisp_fn_t subr_fn; +}; + +typedef struct Lisp_Subr Lisp_Subr; + +DECLARE_LRECORD (subr, Lisp_Subr); +#define XSUBR(x) XRECORD (x, subr, Lisp_Subr) +#define wrap_subr(p) wrap_record (p, subr) +#define SUBRP(x) RECORDP (x, subr) +#define CHECK_SUBR(x) CHECK_RECORD (x, subr) +#define CONCHECK_SUBR(x) CONCHECK_RECORD (x, subr) + +#define subr_function(subr) ((subr)->subr_fn) +#define SUBR_FUNCTION(subr,max_args) \ + ((Lisp_Object (*) (EXFUN_##max_args)) (subr)->subr_fn) +#define subr_name(subr) ((subr)->name) + +/*---------------------------- DEFUN ------------------------------*/ /* DEFUN - Define a built-in Lisp-visible C function or `subr'. `lname' should be the name to give the function in Lisp, ＠＠ -2917,31 +3037,46 ＠＠ #define EXFUN_0 void #define EXFUN_1 Lisp_Object -#define EXFUN_2 Lisp_Object,Lisp_Object -#define EXFUN_3 Lisp_Object,Lisp_Object,Lisp_Object -#define EXFUN_4 Lisp_Object,Lisp_Object,Lisp_Object,Lisp_Object -#define EXFUN_5 Lisp_Object,Lisp_Object,Lisp_Object,Lisp_Object,Lisp_Object -#define EXFUN_6 Lisp_Object,Lisp_Object,Lisp_Object,Lisp_Object,Lisp_Object, \ -Lisp_Object -#define EXFUN_7 Lisp_Object,Lisp_Object,Lisp_Object,Lisp_Object,Lisp_Object, \ -Lisp_Object,Lisp_Object -#define EXFUN_8 Lisp_Object,Lisp_Object,Lisp_Object,Lisp_Object,Lisp_Object, \ -Lisp_Object,Lisp_Object,Lisp_Object +#define EXFUN_2 EXFUN_1,Lisp_Object +#define EXFUN_3 EXFUN_2,Lisp_Object +#define EXFUN_4 EXFUN_3,Lisp_Object +#define EXFUN_5 EXFUN_4,Lisp_Object +#define EXFUN_6 EXFUN_5,Lisp_Object +#define EXFUN_7 EXFUN_6,Lisp_Object +#define EXFUN_8 EXFUN_7,Lisp_Object +#define EXFUN_9 EXFUN_8,Lisp_Object +#define EXFUN_10 EXFUN_9,Lisp_Object +#define EXFUN_11 EXFUN_10,Lisp_Object +#define EXFUN_12 EXFUN_11,Lisp_Object +#define EXFUN_13 EXFUN_12,Lisp_Object +#define EXFUN_14 EXFUN_13,Lisp_Object +#define EXFUN_15 EXFUN_14,Lisp_Object +#define EXFUN_16 EXFUN_15,Lisp_Object +#define EXFUN_17 EXFUN_16,Lisp_Object +#define EXFUN_18 EXFUN_17,Lisp_Object +#define EXFUN_19 EXFUN_18,Lisp_Object +#define EXFUN_20 EXFUN_19,Lisp_Object +#define EXFUN_21 EXFUN_20,Lisp_Object +#define EXFUN_22 EXFUN_21,Lisp_Object +#define EXFUN_23 EXFUN_22,Lisp_Object +#define EXFUN_24 EXFUN_23,Lisp_Object #define EXFUN_MANY int, Lisp_Object* #define EXFUN_UNEVALLED Lisp_Object +#define EXFUN_ALLOW_OTHER int, Lisp_Object_pair * #define EXFUN(sym, max_args) Lisp_Object sym (EXFUN_##max_args) #define EXFUN_NORETURN(sym, max_args) \ DECLARE_DOESNT_RETURN_TYPE (Lisp_Object, sym (EXFUN_##max_args)) #define SUBR_MAX_ARGS 8 +#define SUBR_MAX_KEYWORD_ARGS 16 +#define KEYWORD_NEGATIVE_ARG_CONVERTER -3 #define MANY -2 #define UNEVALLED -1 /* Can't be const, because then subr->doc is read-only and Snarf_documentation chokes */ -#define DEFUN(lname, Fname, min_args, max_args, prompt, arglist) \ - Lisp_Object Fname (EXFUN_##max_args); \ +#define DEFUN_MIDDLE(lname, Fname, min_args, max_args, prompt, arglist) \ static struct Lisp_Subr S##Fname = \ { \ { /* struct lrecord_header */ \ ＠＠ -2953,37 +3088,34 ＠＠ }, \ min_args, \ max_args, \ + 0, /* number of keywords */ \ + 0, /* keyword properties */ \ + 0, /* array of keywords */ \ + 0, /* array of keyword symbols */ \ prompt, \ 0, /* doc string */ \ lname, \ (lisp_fn_t) Fname \ - }; \ + } + +#define DEFUN(lname, Fname, min_args, max_args, prompt, arglist) \ + Lisp_Object Fname (EXFUN_##max_args); \ + DEFUN_MIDDLE (lname, Fname, min_args, max_args, prompt, arglist); \ Lisp_Object Fname (DEFUN_##max_args arglist) #define DEFUN_NORETURN(lname, Fname, min_args, max_args, prompt, arglist) \ DECLARE_DOESNT_RETURN_TYPE (Lisp_Object, Fname (EXFUN_##max_args)); \ - static struct Lisp_Subr S##Fname = \ - { \ - { /* struct lrecord_header */ \ - lrecord_type_subr, /* lrecord_type_index */ \ - 1, /* mark bit */ \ - 1, /* c_readonly bit */ \ - 1, /* lisp_readonly bit */ \ - 0 /* unused */ \ - }, \ - min_args, \ - max_args, \ - prompt, \ - 0, /* doc string */ \ - lname, \ - (lisp_fn_t) Fname \ - }; \ + DEFUN_MIDDLE (lname, Fname, min_args, max_args, prompt, arglist); \ DOESNT_RETURN_TYPE (Lisp_Object) Fname (DEFUN_##max_args arglist) /* Heavy ANSI C preprocessor hackery to get DEFUN to declare a prototype that matches max_args, and add the obligatory `Lisp_Object' type declaration to the formal C arguments. */ +/* WARNING: If you add defines here for higher values of max_args, + make sure to also fix the clauses in PRIMITIVE_FUNCALL(), + and change the define of SUBR_MAX_ARGS above. */ + #define DEFUN_MANY(named_int, named_Lisp_Object) named_int, named_Lisp_Object #define DEFUN_UNEVALLED(args) Lisp_Object args #define DEFUN_0() void ＠＠ -2996,10 +3128,212 ＠＠ #define DEFUN_7(a,b,c,d,e,f,g) DEFUN_6(a,b,c,d,e,f), Lisp_Object g #define DEFUN_8(a,b,c,d,e,f,g,h) DEFUN_7(a,b,c,d,e,f,g),Lisp_Object h -/* WARNING: If you add defines here for higher values of max_args, - make sure to also fix the clauses in PRIMITIVE_FUNCALL(), - and change the define of SUBR_MAX_ARGS above. */ +/* These are only for use below. The extra underscore helps to more + quickly catch attempts to use too many arguments. (Otherwise, you should + get an abort() when the program runs.) */ +#define DEFUN__9(a,b,c,d,e,f,g,h,i) \ + DEFUN_8(a,b,c,d,e,f,g,h),Lisp_Object i +#define DEFUN__10(a,b,c,d,e,f,g,h,i,j) \ + DEFUN_9(a,b,c,d,e,f,g,h,i),Lisp_Object j +#define DEFUN__11(a,b,c,d,e,f,g,h,i,j,k) \ + DEFUN_10(a,b,c,d,e,f,g,h,i,j),Lisp_Object k +#define DEFUN__12(a,b,c,d,e,f,g,h,i,j,k,l) \ + DEFUN_11(a,b,c,d,e,f,g,h,i,j,k),Lisp_Object l +#define DEFUN__13(a,b,c,d,e,f,g,h,i,j,k,l,m) \ + DEFUN_12(a,b,c,d,e,f,g,h,i,j,k,l),Lisp_Object m +#define DEFUN__14(a,b,c,d,e,f,g,h,i,j,k,l,m,n) \ + DEFUN_13(a,b,c,d,e,f,g,h,i,j,k,l,m),Lisp_Object n +#define DEFUN__15(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) \ + DEFUN_14(a,b,c,d,e,f,g,h,i,j,k,l,m,n),Lisp_Object o +#define DEFUN__16(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) \ + DEFUN_15(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o),Lisp_Object p + +#define DWK_ARGS_0 +#define DWK_ARGS_1 DEFUN_1 +#define DWK_ARGS_2 DEFUN_2 +#define DWK_ARGS_3 DEFUN_3 +#define DWK_ARGS_4 DEFUN_4 +#define DWK_ARGS_5 DEFUN_5 +#define DWK_ARGS_6 DEFUN_6 +#define DWK_ARGS_7 DEFUN_7 +#define DWK_ARGS_8 DEFUN_8 + +#define DWK_ARGS_9 DEFUN__9 +#define DWK_ARGS_10 DEFUN__10 +#define DWK_ARGS_11 DEFUN__11 +#define DWK_ARGS_12 DEFUN__12 +#define DWK_ARGS_13 DEFUN__13 +#define DWK_ARGS_14 DEFUN__14 +#define DWK_ARGS_15 DEFUN__15 +#define DWK_ARGS_16 DEFUN__16 + +/* OK, here we get the really bizarre preprocessing -- and all for those + God-damned commas. */ + +#define DWK1_ZERO_0(arg) arg##_0 +#define DWK1_ZERO_1(arg) arg##_1 +#define DWK1_ZERO_2(arg) arg##_1 +#define DWK1_ZERO_3(arg) arg##_1 +#define DWK1_ZERO_4(arg) arg##_1 +#define DWK1_ZERO_5(arg) arg##_1 +#define DWK1_ZERO_6(arg) arg##_1 +#define DWK1_ZERO_7(arg) arg##_1 +#define DWK1_ZERO_8(arg) arg##_1 +#define DWK1_ZERO_9(arg) arg##_1 +#define DWK1_ZERO_10(arg) arg##_1 +#define DWK1_ZERO_11(arg) arg##_1 +#define DWK1_ZERO_12(arg) arg##_1 +#define DWK1_ZERO_13(arg) arg##_1 +#define DWK1_ZERO_14(arg) arg##_1 +#define DWK1_ZERO_15(arg) arg##_1 +#define DWK1_ZERO_16(arg) arg##_1 +#define DWK1_ZERO_17(arg) arg##_1 +#define DWK1_ZERO_18(arg) arg##_1 +#define DWK1_ZERO_19(arg) arg##_1 +#define DWK1_ZERO_20(arg) arg##_1 + +/* DWK_ZERO() boils down to one of two preprocessing constants -- arg_0 if + NUM is 0, and arg_1 NUM is some other number (allows 1 - 20). + + NOTE: If, in the DEFUN_WITH_KEYWORDS stuff below, you get syntax errors, + and it's revealed using gcc -E that some DWK1_ZERO business is hanging + around, try adding another level of indirection ala + DWK_COMMA_IF_NOT_BOTH_ZERO_1. */ +#define DWK_ZERO(arg, num) DWK1_ZERO_##num (arg) + +#define DWK_COMMA_0 +#define DWK_COMMA_1 , + +/* DWK_COMMA_IF_NOT_ZERO() produces nothing if NUM is 0, a comma if NUM is + 1 - 20. */ +#define DWK_COMMA_IF_NOT_ZERO(num) DWK_ZERO (DWK_COMMA, num) + +#define DWK_DWK_CINBZ_1_DWK_CINBZ_1 , +#define DWK_DWK_CINBZ_0_DWK_CINBZ_1 , +#define DWK_DWK_CINBZ_1_DWK_CINBZ_0 , +#define DWK_DWK_CINBZ_0_DWK_CINBZ_0 + +#define DWK_COMMA_IF_NOT_BOTH_ZERO_2(arg1, arg2) \ + DWK_## arg1 ## _ ## arg2 +#define DWK_COMMA_IF_NOT_BOTH_ZERO_1(arg1, arg2) \ + DWK_COMMA_IF_NOT_BOTH_ZERO_2 (arg1, arg2) + +/* DWK_COMMA_IF_NOT_BOTH_ZERO() produces nothing if both numbers are 0, + else a comma. */ +#define DWK_COMMA_IF_NOT_BOTH_ZERO(num1, num2) \ + DWK_COMMA_IF_NOT_BOTH_ZERO_1 (DWK_ZERO (DWK_CINBZ, num1), \ + DWK_ZERO (DWK_CINBZ, num2)) + +/*------------------------- DEFUN_WITH_KEYWORDS ---------------------------*/ + +/* DEFUN_WITH_KEYWORDS - Define a built-in Lisp-visible C function or `subr', + with keyword args in addition to the normal ones. + + `lname', `Fname', `min_args', `max_args' -- same as DEFUN. + `num_keywords' -- number of keywords. + `keyword_props' -- properties of the keywords; one of + 0 (default) + ALLOW_OTHER (other keywords are allowed; the function + will have two more args, + + int num_other_keywords + Lisp_Object_pair *other_keywords + + listing the keyword args other than + those explicitly specified by the + DEFUN.) + DEFAULT_UNBOUND (unspecified keywords will have the value + Qunbound instead of Qnil, so you can + distinguish keywords not given from + keywords with the value nil) + ALLOW_OTHER_DEFAULT_UNBOUND (both of the above apply) + + `prompt', `arglist' -- same as DEFUN. + `keyword_arglist' -- comma-separated keyword arguments. The Lisp-visible + keywords will be constructed by adding a colon to the front and + converting underscores to dashes. + docstring in a comment after `prompt' -- same as DEFUN. + + The resulting function will have one argument for each argument listed in + either arglist or keyword_arglist; in addition, it will have two extra + arguments for other keywords, if ALLOW_OTHER or ALLOW_OTHER_DEFAULT_UNBOUND + was given. + + #### NOTE: The code has not been tested with 0 allowed properties (which + #### might be a reasonable thing to do with ALLOW_OTHER). If you want to + #### do this, and it breaks, either fix the problems, or (if that + #### presents insuperable syntax weirdnesses), create a separate + #### DEFUN_WITH_ALL_KEYWORDS_ALLOWED or something similar. +*/ +#define DWK2STR1(a) #a +#define DWK2STR2(a,b) DWK2STR1(a), #b +#define DWK2STR3(a,b,c) DWK2STR2(a,b), #c +#define DWK2STR4(a,b,c,d) DWK2STR3(a,b,c), #d +#define DWK2STR5(a,b,c,d,e) DWK2STR4(a,b,c,d), #e +#define DWK2STR6(a,b,c,d,e,f) DWK2STR5(a,b,c,d,e), #f +#define DWK2STR7(a,b,c,d,e,f,g) DWK2STR6(a,b,c,d,e,f), #g +#define DWK2STR8(a,b,c,d,e,f,g,h) DWK2STR7(a,b,c,d,e,f,g), #h +#define DWK2STR9(a,b,c,d,e,f,g,h,i) DWK2STR8(a,b,c,d,e,f,g,h), #i +#define DWK2STR10(a,b,c,d,e,f,g,h,i,j) DWK2STR9(a,b,c,d,e,f,g,h,i), #j +#define DWK2STR11(a,b,c,d,e,f,g,h,i,j,k) DWK2STR10(a,b,c,d,e,f,g,h,i,j), #k +#define DWK2STR12(a,b,c,d,e,f,g,h,i,j,k,l) DWK2STR11(a,b,c,d,e,f,g,h,i,j,k),#l +#define DWK2STR13(a,b,c,d,e,f,g,h,i,j,k,l,m) \ + DWK2STR12(a,b,c,d,e,f,g,h,i,j,k,l),#m +#define DWK2STR14(a,b,c,d,e,f,g,h,i,j,k,l,m,n) \ + DWK2STR13(a,b,c,d,e,f,g,h,i,j,k,l,m),#n +#define DWK2STR15(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) \ + DWK2STR14(a,b,c,d,e,f,g,h,i,j,k,l,m,n),#o +#define DWK2STR16(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) \ + DWK2STR15(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o),#p + +#define DEFUN_PROPS_0 0 +#define DEFUN_PROPS_ALLOW_OTHER KEYWORD_ALLOW_OTHER +#define DEFUN_PROPS_DEFAULT_UNBOUND KEYWORD_DEFAULT_UNBOUND +#define DEFUN_PROPS_ALLOW_OTHER_DEFAULT_UNBOUND \ + (KEYWORD_ALLOW_OTHER | KEYWORD_DEFAULT_UNBOUND) + +#define DEFUN_ARGS_0(num1, num2) +#define DEFUN_ARGS_ALLOW_OTHER(num1, num2) \ + DWK_COMMA_IF_NOT_BOTH_ZERO (num1, num2) \ + int num_other_keywords, Lisp_Object_pair *other_keywords +#define DEFUN_ARGS_DEFAULT_UNBOUND(num1, num2) +#define DEFUN_ARGS_ALLOW_OTHER_DEFAULT_UNBOUND(num1, num2) \ + DEFUN_ARGS_ALLOW_OTHER (num1, num2) + +#define DEFUN_WITH_KEYWORDS(lname, Fname, min_args, max_args, num_keywords, \ + keyword_props, prompt, arglist, keyword_arglist) \ +Lisp_Object Fname (DWK_ARGS_##max_args arglist \ + DWK_COMMA_IF_NOT_ZERO (max_args) \ + DWK_ARGS_##num_keywords keyword_arglist \ + DEFUN_ARGS_##keyword_props (max_args, num_keywords)); \ +static const char *S##Fname##_keywords[] = \ + { DWK2STR ## num_keywords keyword_arglist }; \ +static Lisp_Object S##Fname##_keyword_symbols[num_keywords]; \ +static struct Lisp_Subr S##Fname = \ + { \ + { /* struct lrecord_header */ \ + lrecord_type_subr, /* lrecord_type_index */ \ + 1, /* mark bit */ \ + 1, /* c_readonly bit */ \ + 1 /* lisp_readonly bit */ \ + }, \ + min_args, \ + KEYWORD_NEGATIVE_ARG_CONVERTER - max_args, \ + num_keywords, \ + DEFUN_PROPS_##keyword_props, \ + S##Fname##_keywords, \ + S##Fname##_keyword_symbols, \ + prompt, \ + 0, /* doc string */ \ + lname, \ + (lisp_fn_t) Fname \ + }; \ +Lisp_Object Fname (DWK_ARGS_##max_args arglist \ + DWK_COMMA_IF_NOT_ZERO (max_args) \ + DWK_ARGS_##num_keywords keyword_arglist \ + DEFUN_ARGS_##keyword_props (max_args, num_keywords)) + #include "symeval.h" BEGIN_C_DECLS ＠＠ -3488,8 +3822,57 ＠＠ void end_gc_forbidden (int count); extern int gc_currently_forbidden; -END_C_DECLS +void mark_object (Lisp_Object obj); +#ifdef USE_KKCC +void kkcc_gc_stack_push_lisp_object (Lisp_Object obj); +#endif /* USE_KKCC */ + +#ifdef ERROR_CHECK_GC +void GC_CHECK_LHEADER_INVARIANTS (struct lrecord_header *lheader); +#else +#define GC_CHECK_LHEADER_INVARIANTS(lheader) +#endif + +/* I hate duplicating all this crap! */ +DECLARE_INLINE_HEADER ( +int +marked_p (Lisp_Object obj) +) +{ + /* Checks we used to perform. */ + /* if (EQ (obj, Qnull_pointer)) return 1; */ + /* if (!POINTER_TYPE_P (XGCTYPE (obj))) return 1; */ + /* if (PURIFIED (XPNTR (obj))) return 1; */ + + if (XTYPE (obj) == Lisp_Type_Record) + { + struct lrecord_header *lheader = XRECORD_LHEADER (obj); + + GC_CHECK_LHEADER_INVARIANTS (lheader); + return MARKED_RECORD_HEADER_P (lheader); + } + return 1; +} + +DECLARE_INLINE_HEADER ( +int +mark_object_if_not (Lisp_Object obj) +) +{ + if (!marked_p (obj)) + { +#ifdef USE_KKCC + kkcc_gc_stack_push_lisp_object (obj); +#else + mark_object (obj); +#endif + return 1; + } + return 0; +} + +END_C_DECLS  /************************************************************************/ /* Misc definitions */ ＠＠ -3583,11 +3966,6 ＠＠ void free_alist (Lisp_Object); void free_marker (Lisp_Object); int object_dead_p (Lisp_Object); -void mark_object (Lisp_Object obj); -#ifdef USE_KKCC -void kkcc_gc_stack_push_lisp_object (Lisp_Object obj); -#endif /* USE_KKCC */ -int marked_p (Lisp_Object obj); extern int funcall_allocation_flag; extern int need_to_garbage_collect; extern MODULE_API int need_to_check_c_alloca; ＠＠ -3671,6 +4049,11 ＠＠ DECLARE_DOESNT_RETURN (invalid_byte_code (const CIbyte *reason, Lisp_Object frob)); +/* Defined in callproc.c */ +Ibyte *egetenv (const CIbyte *var); +void eputenv (const CIbyte *var, const CIbyte *value); +extern int env_initted; + /* Defined in callint.c */ EXFUN (Fcall_interactively, 3); EXFUN (Fprefix_numeric_value, 1); ＠＠ -3694,6 +4077,9 ＠＠ EXFUN (Fforward_char, 2); EXFUN (Fforward_line, 2); +/* Defined in console.c */ +EXFUN (Fcdfw_console, 1); + /* Defined in data.c */ EXFUN (Fadd1, 1); EXFUN (Faref, 2); ＠＠ -4192,15 +4578,8 ＠＠ void wait_delaying_user_input (int (*) (void *), void *); int detect_input_pending (int how_many); void reset_this_command_keys (Lisp_Object, int); -Lisp_Object enqueue_misc_user_event (Lisp_Object, Lisp_Object, Lisp_Object); -Lisp_Object enqueue_misc_user_event_pos (Lisp_Object, Lisp_Object, - Lisp_Object, int, int, int, int); extern int modifier_keys_are_sticky; -/* Defined in event-Xt.c */ -void signal_special_Xt_user_event (Lisp_Object, Lisp_Object, Lisp_Object); - - /* Defined in events.c */ EXFUN (Fcopy_event, 2); EXFUN (Fevent_to_character, 4); ＠＠ -4210,6 +4589,8 ＠＠ EXFUN (Fevent_x_pixel, 1); EXFUN (Fevent_y_pixel, 1); +EXFUN (Fevent_property, 2); +EXFUN (Fevent_properties, 1); /* Defined in file-coding.c */ ＠＠ -4378,6 +4759,8 ＠＠ Lisp_Object remassq_no_quit (Lisp_Object, Lisp_Object); Lisp_Object remrassq_no_quit (Lisp_Object, Lisp_Object); +Lisp_Object make_plist_from_lisp_object_pair_array (int numels, + Lisp_Object_pair *els); int plists_differ (Lisp_Object, Lisp_Object, int, int, int); Lisp_Object internal_plist_get (Lisp_Object, Lisp_Object); void internal_plist_put (Lisp_Object *, Lisp_Object, Lisp_Object); ＠＠ -4436,8 +4819,8 ＠＠ EXFUN (Fvertical_motion, 3); int byte_spaces_at_point (struct buffer *, Bytebpos); -int column_at_point (struct buffer *, Charbpos, int); -int string_column_at_point (Lisp_Object, Charbpos, int); +int column_at_point (Lisp_Object textobj, Charxpos init_pos, int tab_width, + int cur_col); int current_column (struct buffer *); void invalidate_current_column (void); Charbpos vmotion (struct window *, Charbpos, int, int *); ＠＠ -4634,12 +5017,15 ＠＠ struct re_registers; Charbpos scan_buffer (struct buffer *, Ichar, Charbpos, Charbpos, EMACS_INT, EMACS_INT *, int); -Charbpos find_next_newline (struct buffer *, Charbpos, int); -Charbpos find_next_newline_no_quit (struct buffer *, Charbpos, int); -Bytebpos byte_find_next_newline_no_quit (struct buffer *, Bytebpos, int); +Charbpos find_next_newline (struct buffer *, Charbpos, EMACS_INT); +Charbpos find_next_newline_no_quit (struct buffer *, Charbpos, EMACS_INT); +Bytebpos byte_find_next_newline_no_quit (struct buffer *, Bytebpos, EMACS_INT); +Bytebpos byte_find_next_ichar_no_quit (struct buffer *buf, Ichar target, + Bytebpos from, EMACS_INT count); Bytecount byte_find_next_ichar_in_string (Lisp_Object, Ichar, Bytecount, EMACS_INT); -Charbpos find_before_next_newline (struct buffer *, Charbpos, Charbpos, int); +Charbpos find_before_next_newline (struct buffer *, Charbpos, Charbpos, + EMACS_INT); struct re_pattern_buffer *compile_pattern (Lisp_Object pattern, struct re_registers *regp, Lisp_Object translate, ＠＠ -4786,24 +5172,16 ＠＠ void get_string_range_byte (Lisp_Object string, Lisp_Object from, Lisp_Object to, Bytecount *from_out, Bytecount *to_out, unsigned int flags); -Charxpos get_buffer_or_string_pos_char (Lisp_Object object, Lisp_Object pos, +Charxpos get_textobj_pos_char (Lisp_Object object, Lisp_Object pos, unsigned int flags); -Bytexpos get_buffer_or_string_pos_byte (Lisp_Object object, Lisp_Object pos, +Bytexpos get_textobj_pos_byte (Lisp_Object object, Lisp_Object pos, unsigned int flags); -void get_buffer_or_string_range_char (Lisp_Object object, Lisp_Object from, +void get_textobj_range_char (Lisp_Object object, Lisp_Object from, Lisp_Object to, Charxpos *from_out, Charxpos *to_out, unsigned int flags); -void get_buffer_or_string_range_byte (Lisp_Object object, Lisp_Object from, +void get_textobj_range_byte (Lisp_Object object, Lisp_Object from, Lisp_Object to, Bytexpos *from_out, Bytexpos *to_out, unsigned int flags); -Charxpos buffer_or_string_accessible_begin_char (Lisp_Object object); -Charxpos buffer_or_string_accessible_end_char (Lisp_Object object); -Bytexpos buffer_or_string_accessible_begin_byte (Lisp_Object object); -Bytexpos buffer_or_string_accessible_end_byte (Lisp_Object object); -Charxpos buffer_or_string_absolute_begin_char (Lisp_Object object); -Charxpos buffer_or_string_absolute_end_char (Lisp_Object object); -Bytexpos buffer_or_string_absolute_begin_byte (Lisp_Object object); -Bytexpos buffer_or_string_absolute_end_byte (Lisp_Object object); Charbpos charbpos_clip_to_bounds (Charbpos lower, Charbpos num, Charbpos upper); Bytebpos bytebpos_clip_to_bounds (Bytebpos lower, Bytebpos num, ＠＠ -4812,14 +5190,10 ＠＠ Charxpos upper); Bytexpos bytexpos_clip_to_bounds (Bytexpos lower, Bytexpos num, Bytexpos upper); -Charxpos buffer_or_string_clip_to_accessible_char (Lisp_Object object, - Charxpos pos); -Bytexpos buffer_or_string_clip_to_accessible_byte (Lisp_Object object, - Bytexpos pos); -Charxpos buffer_or_string_clip_to_absolute_char (Lisp_Object object, - Charxpos pos); -Bytexpos buffer_or_string_clip_to_absolute_byte (Lisp_Object object, - Bytexpos pos); +Charxpos textobj_clip_to_accessible_char (Lisp_Object object, Charxpos pos); +Bytexpos textobj_clip_to_accessible_byte (Lisp_Object object, Bytexpos pos); +Charxpos textobj_clip_to_absolute_char (Lisp_Object object, Charxpos pos); +Bytexpos textobj_clip_to_absolute_byte (Lisp_Object object, Bytexpos pos); #ifdef ENABLE_COMPOSITE_CHARS ＠＠ -5242,7 +5616,8 ＠＠ extern Lisp_Object Qset, Qsetting_constant, Qshort_name, Qsingularity_error; extern Lisp_Object Qsound_error, Qstack_overflow, Qstandard_input; extern Lisp_Object Qstandard_output, Qstart_open, Qstring_lessp; -extern Lisp_Object Qstructure_formation_error, Qsubwindow; +extern Lisp_Object Qstructure_formation_error; +extern Lisp_Object Qsubcontrol_image_instance_p, Qsubwindow; extern Lisp_Object Qsubwindow_image_instance_p; extern Lisp_Object Qtext_conversion_error, Qtext_image_instance_p, Qtop_level; extern Lisp_Object Qtrue_list_p, Qunderflow_error, Qunderline; 1.75.4.1 +3 -3 XEmacs/xemacs/src/lread.c Index: lread.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/lread.c,v retrieving revision 1.75 retrieving revision 1.75.4.1 diff -u -r1.75 -r1.75.4.1 --- lread.c 2005/02/04 11:57:29 1.75 +++ lread.c 2005/02/16 00:43:36 1.75.4.1 ＠＠ -247,7 +247,7 ＠＠ if (BUF_PT (b) >= BUF_ZV (b)) return -1; - c = BUF_FETCH_CHAR (b, BUF_PT (b)); + c = BUF_ICHAR_AT (b, BUF_PT (b)); BUF_SET_PT (b, BUF_PT (b) + 1); return c; ＠＠ -274,7 +274,7 ＠＠ if (mpos >= BUF_ZV (inbuffer)) return -1; - c = BUF_FETCH_CHAR (inbuffer, mpos); + c = BUF_ICHAR_AT (inbuffer, mpos); set_marker_position (readcharfun, mpos + 1); return c; } ＠＠ -3340,7 +3340,7 ＠＠ staticpro (&Vread_objects); Vlocate_file_hash_table = make_lisp_hash_table (200, - HASH_TABLE_NON_WEAK, + hash_table_non_weak, HASH_TABLE_EQUAL); staticpro (&Vlocate_file_hash_table); #ifdef DEBUG_XEMACS 1.36.4.1 +1 -2 XEmacs/xemacs/src/lrecord.h Index: lrecord.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/lrecord.h,v retrieving revision 1.36 retrieving revision 1.36.4.1 diff -u -r1.36 -r1.36.4.1 --- lrecord.h 2005/02/03 16:14:07 1.36 +++ lrecord.h 2005/02/16 00:43:36 1.36.4.1 ＠＠ -1,6 +1,6 ＠＠ /* The "lrecord" structure (header of a compound lisp object). Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc. - Copyright (C) 1996, 2001, 2002, 2004 Ben Wing. + Copyright (C) 1996, 2001, 2002, 2004, 2005 Ben Wing. This file is part of XEmacs. ＠＠ -321,7 +321,6 ＠＠ #define MARKED_RECORD_HEADER_P(lheader) ((lheader)->mark) #define MARK_RECORD_HEADER(lheader) ((void) ((lheader)->mark = 1)) #define UNMARK_RECORD_HEADER(lheader) ((void) ((lheader)->mark = 0)) - #define C_READONLY_RECORD_HEADER_P(lheader) ((lheader)->c_readonly) #define LISP_READONLY_RECORD_HEADER_P(lheader) ((lheader)->lisp_readonly) #define SET_C_READONLY_RECORD_HEADER(lheader) do { \ 1.22.4.1 +26 -14 XEmacs/xemacs/src/menubar-gtk.c Index: menubar-gtk.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/menubar-gtk.c,v retrieving revision 1.22 retrieving revision 1.22.4.1 diff -u -r1.22 -r1.22.4.1 --- menubar-gtk.c 2005/01/24 23:34:03 1.22 +++ menubar-gtk.c 2005/02/16 00:43:37 1.22.4.1 ＠＠ -1,7 +1,7 ＠＠ /* Implements an elisp-programmable menubar -- Gtk interface. Copyright (C) 1993, 1994 Free Software Foundation, Inc. Copyright (C) 1995 Tinker Systems and INS Engineering Corp. - Copyright (C) 2002, 2003 Ben Wing. + Copyright (C) 2002, 2003, 2005 Ben Wing. This file is part of XEmacs. ＠＠ -738,15 +738,13 ＠＠ static void __generic_button_callback (GtkMenuItem *item, gpointer user_data) { - Lisp_Object callback, function, data, channel; + Lisp_Object cons, data, channel; channel = wrap_frame (gtk_widget_to_frame (GTK_WIDGET (item))); - callback = VOID_TO_LISP (user_data); - - get_gui_callback (callback, &function, &data); - - signal_special_gtk_user_event (channel, function, data); + cons = VOID_TO_LISP (user_data); + gtk_enqueue_activate_event (ACTIVATE_MENU_SELECTION, channel, XCAR (cons), + XCDR (cons)); } /* Convert a single menu item descriptor to a suitable GtkMenuItem */ ＠＠ -1004,13 +1002,27 ＠＠ gtk_widget_set_sensitive (widget, ! NILP (active_p)); - gtk_signal_connect (GTK_OBJECT (widget), "activate-item", - GTK_SIGNAL_FUNC (__generic_button_callback), - LISP_TO_VOID (callback)); - - gtk_signal_connect (GTK_OBJECT (widget), "activate", - GTK_SIGNAL_FUNC (__generic_button_callback), - LISP_TO_VOID (callback)); + { + Lisp_Object cons = Fcons (name, callback); + gtk_signal_connect (GTK_OBJECT (widget), "activate-item", + GTK_SIGNAL_FUNC (__generic_button_callback), + LISP_TO_VOID (cons)); + + gtk_signal_connect (GTK_OBJECT (widget), "activate", + GTK_SIGNAL_FUNC (__generic_button_callback), + LISP_TO_VOID (cons)); +#error Fix me! + /* #### Bill, fix me; We now need to communicate both the name and + #### the callback (and potentially more stuff -- why don't you + #### do what the code elsewhere does and create a gui-item to + #### hold everything, which then gets sent to + #### __generic_button_callback?) to __generic_button_callback. + #### Unfortunately, this cons will not be gc-protected. You + #### need to figure out a way to keep this cons gc-protected. I + #### don't understand this code well enough. Maybe you can + #### create a hash table mapping something to the cons; but then + #### you need to figure out when to get rid of the cons. --ben */ + } /* Now that all the information about the menu item is know, set the remaining properties. 1.44.4.1 +39 -32 XEmacs/xemacs/src/menubar-msw.c Index: menubar-msw.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/menubar-msw.c,v retrieving revision 1.44 retrieving revision 1.44.4.1 diff -u -r1.44 -r1.44.4.1 --- menubar-msw.c 2005/01/24 23:34:03 1.44 +++ menubar-msw.c 2005/02/16 00:43:38 1.44.4.1 ＠＠ -39,24 +39,36 ＠＠ * current-menubar is found, and the newly open pulldown is * populated. This is made again in the same non-recursive manner. * + * We use hash tables, one per frame, to keep track of menubar data. The + * hash table maps as follows: + * + * (1) opaque ptrs, wrapping HMENU descriptors, map to lists of strings, + * specifying the path to a submenu. + * + * (2) specially created ID's (integers, see below) map to gui-item + * objects, for menu leaves. + * + * (3) `t' maps to a list of characters, specifying the characters used as + * menu accelerators, so that ALT sequences with these characters can be + * intercepted and processed when necessary. + * * This algorithm uses hash tables to find out element of the menu - * descriptor list given menu handle. The key is an opaque ptr data - * type, keeping menu handle, and the value is a list of strings - * representing the path from the root of the menu to the item - * descriptor. Each frame has an associated hash table. + * descriptor list given menu handle. The key is an opaque ptr data type, + * keeping menu handle, and the value is a list of strings representing the + * path from the root of the menu to the item descriptor. Each frame has an + * associated hash table. * - * Leaf items are assigned a unique id based on item's hash. When an - * item is selected, Windows sends back the id. Unfortunately, only - * low 16 bit of the ID are sent, and there's no way to get the 32-bit - * value. Yes, Win32 is just a different set of bugs than X! Aside - * from this blame, another hashing mechanism is required to map menu - * ids to commands (which are actually Lisp_Object's). This mapping is - * performed in the same hash table, as the lifetime of both maps is - * exactly the same. This is unambigous, as menu handles are - * represented by lisp opaques, while command ids are by lisp - * integers. The additional advantage for this is that command forms - * are automatically GC-protected, which is important because these - * may be transient forms generated by :filter functions. + * Leaf items are assigned a unique id based on item's hash. When an item + * is selected, Windows sends back the id. Unfortunately, only low 16 bit + * of the ID are sent, and there's no way to get the 32-bit value. Yes, + * Win32 is just a different set of bugs than X! Aside from this blame, + * another hashing mechanism is required to map menu ids to gui-items + * (which keep track of the item text, callback, etc. that must be stored + * into the menu event). This mapping is performed in the same hash table, + * as the lifetime of both maps is exactly the same. This is unambigous, as + * menu handles are represented by lisp opaques, while command ids are by + * lisp integers. The additional advantage for this is that command forms + * are automatically GC-protected. * * The hash table is not allowed to grow too much; it is pruned * whenever this is safe to do. This is done by re-creating the menu ＠＠ -265,7 +277,7 ＠＠ if (!STRINGP (pgui_item->name)) invalid_argument ("Menu name (first element) must be a string", - item); + item); if (!gui_item_included_p (gui_item, Vmenubar_configuration)) { ＠＠ -344,7 +356,7 ＠＠ id = allocate_menu_item_id (path, pgui_item->name, pgui_item->suffix); - Fputhash (id, pgui_item->callback, hash_tab); + Fputhash (id, gui_item, hash_tab); item_info.wID = (UINT) XINT (id); item_info.fType |= MFT_STRING; ＠＠ -531,7 +543,7 ＠＠ /* Come with empty hash table */ if (NILP (FRAME_MSWINDOWS_MENU_HASH_TABLE (f))) FRAME_MSWINDOWS_MENU_HASH_TABLE (f) = - make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); + make_lisp_hash_table (50, hash_table_non_weak, HASH_TABLE_EQUAL); else Fclrhash (FRAME_MSWINDOWS_MENU_HASH_TABLE (f)); ＠＠ -677,15 +689,15 ＠＠ mswindows_handle_wm_command (struct frame *f, WORD id) { /* Try to map the command id through the proper hash table */ - Lisp_Object data, fn, arg, frame; + Lisp_Object gui; struct gcpro gcpro1; if (NILP (current_hash_table)) return Qnil; - data = Fgethash (make_int (id), current_hash_table, Qunbound); + gui = Fgethash (make_int (id), current_hash_table, Qunbound); - if (UNBOUNDP (data)) + if (UNBOUNDP (gui)) { menu_cleanup (f); return Qnil; ＠＠ -693,19 +705,14 ＠＠ /* Need to gcpro because the hash table may get destroyed by menu_cleanup(), and will not gcpro the data any more */ - GCPRO1 (data); + GCPRO1 (gui); menu_cleanup (f); /* Ok, this is our one. Enqueue it. */ - get_gui_callback (data, &fn, &arg); - frame = wrap_frame (f); - /* this used to call mswindows_enqueue_misc_user_event but that - breaks customize because the misc_event gets eval'ed in some - circumstances. Don't change it back unless you can fix the - customize problem also. */ - mswindows_enqueue_misc_user_event (frame, fn, arg); + enqueue_activate_event (ACTIVATE_MENU_SELECTION, wrap_frame (f), + XGUI_ITEM (gui)->name, XGUI_ITEM (gui)->callback); - UNGCPRO; /* data */ + UNGCPRO; return Qt; } ＠＠ -842,7 +849,7 ＠＠ current_menudesc = menu_desc; current_hash_table = - make_lisp_hash_table (10, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); + make_lisp_hash_table (10, hash_table_non_weak, HASH_TABLE_EQUAL); menu = create_empty_popup_menu (); Fputhash (hmenu_to_lisp_object (menu), Qnil, current_hash_table); top_level_menu = menu; 1.29.4.1 +5 -8 XEmacs/xemacs/src/menubar.c Index: menubar.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/menubar.c,v retrieving revision 1.29 retrieving revision 1.29.4.1 diff -u -r1.29 -r1.29.4.1 --- menubar.c 2005/02/03 05:03:45 1.29 +++ menubar.c 2005/02/16 00:43:38 1.29.4.1 ＠＠ -1,7 +1,7 ＠＠ /* Implements an elisp-programmable menubar. Copyright (C) 1993, 1994 Free Software Foundation, Inc. Copyright (C) 1995 Tinker Systems and INS Engineering Corp. - Copyright (C) 2001, 2002, 2003 Ben Wing. + Copyright (C) 2001, 2002, 2003, 2005 Ben Wing. This file is part of XEmacs. ＠＠ -764,13 +764,6 ＠＠ the actions of menu traversal keys in a commonly used PC operating system. */ ); - Fprovide (intern ("menubar")); - Fprovide (intern ("menu-accelerator-support")); -} - -void -specifier_vars_of_menubar (void) -{ DEFVAR_SPECIFIER ("menubar-visible-p", &Vmenubar_visible_p /* *Whether the menubar is visible. This is a specifier; use `set-specifier' to change it. ＠＠ -783,7 +776,11 ＠＠ menubar_visible_p_changed, offsetof (struct frame, menubar_visible_p), menubar_visible_p_changed_in_frame, 0); + + Fprovide (intern ("menubar")); + Fprovide (intern ("menu-accelerator-support")); } + void complex_vars_of_menubar (void) 1.21.6.1 +2 -2 XEmacs/xemacs/src/minibuf.c Index: minibuf.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/minibuf.c,v retrieving revision 1.21 retrieving revision 1.21.6.1 diff -u -r1.21 -r1.21.6.1 --- minibuf.c 2004/11/04 23:06:42 1.21 +++ minibuf.c 2005/02/16 00:43:39 1.21.6.1 ＠＠ -623,8 +623,8 ＠＠ /* Reject alternatives that start with space unless the input starts with space. */ && ((string_char_length (string) > 0 && - string_ichar (string, 0) == ' ') - || string_ichar (eltstring, 0) != ' ') + string_ichar_at (string, 0) == ' ') + || string_ichar_at (eltstring, 0) != ' ') && (0 > scmp (XSTRING_DATA (eltstring), XSTRING_DATA (string), slength))) 1.41.4.1 +1 -1 XEmacs/xemacs/src/mule-charset.c Index: mule-charset.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/mule-charset.c,v retrieving revision 1.41 retrieving revision 1.41.4.1 diff -u -r1.41 -r1.41.4.1 --- mule-charset.c 2005/02/03 16:14:07 1.41 +++ mule-charset.c 2005/02/16 00:43:39 1.41.4.1 ＠＠ -1023,7 +1023,7 ＠＠ staticpro (&Vcharset_hash_table); Vcharset_hash_table = - make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (50, hash_table_non_weak, HASH_TABLE_EQ); } void 1.34.4.1 +1 -1 XEmacs/xemacs/src/mule-coding.c Index: mule-coding.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/mule-coding.c,v retrieving revision 1.34 retrieving revision 1.34.4.1 diff -u -r1.34 -r1.34.4.1 --- mule-coding.c 2005/02/03 16:14:07 1.34 +++ mule-coding.c 2005/02/16 00:43:40 1.34.4.1 ＠＠ -207,7 +207,7 ＠＠ { DECODE_SHIFT_JIS (s1, s2, c1, c2); return make_char (make_ichar (Vcharset_japanese_jisx0208, - c1 & 0x7F, c2 & 0x7F)); + c1 & 0x7F, c2 & 0x7F)); } else return Qnil; 1.26.6.1 +57 -79 XEmacs/xemacs/src/mule-wnnfns.c Index: mule-wnnfns.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/mule-wnnfns.c,v retrieving revision 1.26 retrieving revision 1.26.6.1 diff -u -r1.26 -r1.26.6.1 --- mule-wnnfns.c 2004/11/04 23:06:43 1.26 +++ mule-wnnfns.c 2005/02/16 00:43:40 1.26.6.1 ＠＠ -436,40 +436,36 ＠＠ return Qt; } -DEFUN ("wnn-server-dict-add", Fwnn_dict_add, 5, MANY, 0, /* +DEFUN ("wnn-server-dict-add", Fwnn_dict_add, 5, 7, 0, /* Add dictionary specified by DICT-FILE-NAME, FREQ-FILE-NAME, PRIORITY, DICT-FILE-MODE, FREQ-FILE-MODE. Specify password files of dictionary and frequency, PW1 and PW2, if needed. */ - (int nargs, Lisp_Object *args)) + (dict_file_name, freq_file_name, priority, dict_file_mode, + freq_file_mode, pw1, pw2)) { - struct gcpro gcpro1; int snum; - CHECK_STRING (args[0]); - CHECK_STRING (args[1]); - CHECK_INT (args[2]); - if (! NILP (args[5])) CHECK_STRING (args[5]); - if (! NILP (args[6])) CHECK_STRING (args[6]); + CHECK_STRING (dict_file_name); + CHECK_STRING (freq_file_name); + CHECK_INT (priority); + if (! NILP (pw1)) CHECK_STRING (pw1); + if (! NILP (pw2)) CHECK_STRING (pw2); if ((snum = check_wnn_server_type ()) == -1) return Qnil; if (!wnnfns_buf[snum]) return Qnil; - GCPRO1 (*args); - gcpro1.nvars = nargs; if (jl_dic_add (wnnfns_buf[snum], - XSTRING_DATA (args[0]), - XSTRING_DATA (args[1]), + XSTRING_DATA (dict_file_name), + XSTRING_DATA (freq_file_name), wnnfns_norm ? WNN_DIC_ADD_NOR : WNN_DIC_ADD_REV, - XINT (args[2]), - NILP (args[3]) ? WNN_DIC_RDONLY : WNN_DIC_RW, - NILP (args[4]) ? WNN_DIC_RDONLY : WNN_DIC_RW, - NILP (args[5]) ? 0 : XSTRING_DATA (args[5]), - NILP (args[6]) ? 0 : XSTRING_DATA (args[6]), + XINT (priority), + NILP (dict_file_mode) ? WNN_DIC_RDONLY : WNN_DIC_RW, + NILP (freq_file_mode) ? WNN_DIC_RDONLY : WNN_DIC_RW, + NILP (pw1) ? 0 : XSTRING_DATA (pw1), + NILP (pw2) ? 0 : XSTRING_DATA (pw2), yes_or_no, puts2 ) < 0) { - UNGCPRO; return Qnil; } - UNGCPRO; return Qt; } ＠＠ -1279,92 +1275,81 ＠＠ return make_string (name, strlen ((char *) name)); } #ifdef WNN6 -DEFUN ("wnn-server-fisys-dict-add", Fwnn_fisys_dict_add, 3, MANY, 0, /* +DEFUN ("wnn-server-fisys-dict-add", Fwnn_fisys_dict_add, 3, 4, 0, /* Add dictionary specified by FISYS-DICT-FILE-NAME, FISYS-FREQ-FILE-NAME, FISYS-FREQ-FILE-MODE. -Specify password files of dictionary and frequency, PW1 and PW2, if needed. +Specify password files of dictionary and frequency, PW1, if needed. */ - (int nargs, Lisp_Object *args)) + (fisys_dict_file_name, fisys_freq_file_name, + fisys_freq_file_mode, pw1, pw2)) { - struct gcpro gcpro1; int snum; - CHECK_STRING (args[0]); - CHECK_STRING (args[1]); - if (! NILP (args[3])) CHECK_STRING (args[3]); + CHECK_STRING (fisys_dict_file_name); + CHECK_STRING (fisys_freq_file_name); + if (! NILP (pw1)) CHECK_STRING (pw1); if ((snum = check_wnn_server_type()) == -1) return Qnil; if(!wnnfns_buf[snum]) return Qnil; - GCPRO1 (*args); - gcpro1.nvars = nargs; if(jl_fi_dic_add(wnnfns_buf[snum], - XSTRING_DATA (args[0]), - XSTRING_DATA (args[1]), + XSTRING_DATA (fisys_dict_file_name), + XSTRING_DATA (fisys_freq_file_name), WNN_FI_SYSTEM_DICT, WNN_DIC_RDONLY, - NILP (args[2]) ? WNN_DIC_RDONLY : WNN_DIC_RW, + NILP (fisys_freq_file_mode) ? WNN_DIC_RDONLY : WNN_DIC_RW, 0, - NILP (args[3]) ? 0 : XSTRING_DATA (args[3]), + NILP (pw1) ? 0 : XSTRING_DATA (pw1), yes_or_no, puts2 ) < 0) { - UNGCPRO; return Qnil; } - UNGCPRO; return Qt; } -DEFUN ("wnn-server-fiusr-dict-add", Fwnn_fiusr_dict_add, 4, MANY, 0, /* +DEFUN ("wnn-server-fiusr-dict-add", Fwnn_fiusr_dict_add, 4, 6, 0, /* Add dictionary specified by FIUSR-DICT-FILE-NAME, FIUSR-FREQ-FILE-NAME, FIUSR-DICT-FILE-MODE, FIUSR-FREQ-FILE-MODE. Specify password files of dictionary and frequency, PW1 and PW2, if needed. */ - (int nargs, Lisp_Object *args)) + (fiusr_dict_file_name, fiusr_freq_file_name, + fiusr_dict_file_mode, fiusr_freq_file_mode, pw1, pw2)) { - struct gcpro gcpro1; int snum; - CHECK_STRING (args[0]); - CHECK_STRING (args[1]); - if (! NILP (args[4])) CHECK_STRING (args[4]); - if (! NILP (args[5])) CHECK_STRING (args[5]); + CHECK_STRING (fiusr_dict_file_name); + CHECK_STRING (fiusr_freq_file_name); + if (! NILP (pw1)) CHECK_STRING (pw1); + if (! NILP (pw2)) CHECK_STRING (pw2); if ((snum = check_wnn_server_type()) == -1) return Qnil; if(!wnnfns_buf[snum]) return Qnil; - GCPRO1 (*args); - gcpro1.nvars = nargs; if(jl_fi_dic_add(wnnfns_buf[snum], - XSTRING_DATA (args[0]), - XSTRING_DATA (args[1]), + XSTRING_DATA (fiusr_dict_file_name), + XSTRING_DATA (fiusr_freq_file_name), WNN_FI_USER_DICT, - NILP (args[2]) ? WNN_DIC_RDONLY : WNN_DIC_RW, - NILP (args[3]) ? WNN_DIC_RDONLY : WNN_DIC_RW, - NILP (args[4]) ? 0 : XSTRING_DATA (args[4]), - NILP (args[5]) ? 0 : XSTRING_DATA (args[5]), + NILP (fiusr_dict_file_mode) ? WNN_DIC_RDONLY : WNN_DIC_RW, + NILP (fiusr_freq_file_mode) ? WNN_DIC_RDONLY : WNN_DIC_RW, + NILP (pw1) ? 0 : XSTRING_DATA (pw1), + NILP (pw2) ? 0 : XSTRING_DATA (pw2), yes_or_no, puts2 ) < 0) { - UNGCPRO; return Qnil; } - UNGCPRO; return Qt; } -DEFUN ("wnn-server-notrans-dict-add", Fwnn_notrans_dict_add, 3, MANY, 0, /* +DEFUN ("wnn-server-notrans-dict-add", Fwnn_notrans_dict_add, 3, 4, 0, /* Add dictionary specified by NOTRANS-DICT-FILE-NAME, PRIORITY, DICT-FILE-MODE. Specify password files of dictionary and frequency PW1 if needed. */ - (int nargs, Lisp_Object *args)) + (notrans_dict_file_name, priority, dict_file_mode, pw1)) { - struct gcpro gcpro1; int snum; int dic_no; struct wnn_env *cur_env; unsigned long vmask = 0; struct wnn_henkan_env henv; - CHECK_STRING (args[0]); - CHECK_INT (args[1]); - if (! NILP (args[3])) CHECK_STRING (args[3]); + CHECK_STRING (notrans_dict_file_name); + CHECK_INT (priority); + if (! NILP (pw1)) CHECK_STRING (pw1); if ((snum = check_wnn_server_type()) == -1) return Qnil; if(!wnnfns_buf[snum]) return Qnil; - GCPRO1 (*args); - gcpro1.nvars = nargs; if(wnnfns_norm) cur_env = wnnfns_env_norm[snum]; else ＠＠ -1372,16 +1357,15 ＠＠ dic_no = js_get_autolearning_dic(cur_env, WNN_MUHENKAN_LEARNING); if (dic_no == WNN_NO_LEARNING) { if((dic_no = jl_dic_add(wnnfns_buf[snum], - XSTRING_DATA (args[0]), + XSTRING_DATA (notrans_dict_file_name), 0, wnnfns_norm ? WNN_DIC_ADD_NOR : WNN_DIC_ADD_REV, - XINT(args[1]), + XINT(priority), WNN_DIC_RW, WNN_DIC_RW, - NILP (args[3]) ? 0 : XSTRING_DATA (args[3]), + NILP (pw1) ? 0 : XSTRING_DATA (pw1), 0, yes_or_no, puts2)) < 0) { - UNGCPRO; return Qnil; } js_set_autolearning_dic(cur_env, WNN_MUHENKAN_LEARNING, dic_no); ＠＠ -1389,41 +1373,35 ＠＠ if(!js_is_loaded_temporary_dic(cur_env)) { if(js_temporary_dic_add(cur_env, wnnfns_norm ? WNN_DIC_ADD_NOR : WNN_DIC_ADD_REV) < 0) { - UNGCPRO; return Qnil; } } vmask |= WNN_ENV_MUHENKAN_LEARN_MASK; - henv.muhenkan_flag = NILP (args[2]) ? WNN_DIC_RDONLY : WNN_DIC_RW; + henv.muhenkan_flag = NILP (dict_file_mode) ? WNN_DIC_RDONLY : WNN_DIC_RW; if(jl_set_henkan_env(wnnfns_buf[snum], vmask, &henv) < 0) { - UNGCPRO; return Qnil; } - UNGCPRO; return Qt; } -DEFUN ("wnn-server-bmodify-dict-add", Fwnn_bmodify_dict_add, 3, MANY, 0, /* +DEFUN ("wnn-server-bmodify-dict-add", Fwnn_bmodify_dict_add, 3, 4, 0, /* Add dictionary specified by BMODIFY-DICT-FILE-NAME, PRIORITY, DICT-FILE-MODE. Specify password files of dictionary and frequency PW1 if needed. */ - (int nargs, Lisp_Object *args)) + (bmodify_dict_file_name, priority, dict_file_mode, pw1)) { - struct gcpro gcpro1; int snum; int dic_no; struct wnn_env *cur_env; unsigned long vmask = 0; struct wnn_henkan_env henv; - CHECK_STRING (args[0]); - CHECK_INT (args[1]); - if (! NILP (args[3])) CHECK_STRING (args[3]); + CHECK_STRING (bmodify_dict_file_name); + CHECK_INT (priority); + if (! NILP (pw1)) CHECK_STRING (pw1); if ((snum = check_wnn_server_type()) == -1) return Qnil; if(!wnnfns_buf[snum]) return Qnil; - GCPRO1 (*args); - gcpro1.nvars = nargs; if(wnnfns_norm) cur_env = wnnfns_env_norm[snum]; else ＠＠ -1431,12 +1409,12 ＠＠ dic_no = js_get_autolearning_dic(cur_env, WNN_BUNSETSUGIRI_LEARNING); if (dic_no == WNN_NO_LEARNING) { if((dic_no = jl_dic_add(wnnfns_buf[snum], - XSTRING_DATA (args[0]), + XSTRING_DATA (bmodify_dict_file_name), 0, wnnfns_norm ? WNN_DIC_ADD_NOR : WNN_DIC_ADD_REV, - XINT(args[1]), + XINT(priority), WNN_DIC_RW, WNN_DIC_RW, - NILP (args[3]) ? 0 : XSTRING_DATA (args[3]), + NILP (pw1) ? 0 : XSTRING_DATA (pw1), 0, yes_or_no, puts2)) < 0) { ＠＠ -1453,7 +1431,7 ＠＠ } } vmask |= WNN_ENV_BUNSETSUGIRI_LEARN_MASK; - henv.bunsetsugiri_flag = NILP (args[2]) ? WNN_DIC_RDONLY : WNN_DIC_RW; + henv.bunsetsugiri_flag = NILP (dict_file_mode) ? WNN_DIC_RDONLY : WNN_DIC_RW; if(jl_set_henkan_env(wnnfns_buf[snum], vmask, &henv) < 0) { 1.5.4.1 +1 -1 XEmacs/xemacs/src/native-gtk-toolbar.c Index: native-gtk-toolbar.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/native-gtk-toolbar.c,v retrieving revision 1.5 retrieving revision 1.5.4.1 diff -u -r1.5 -r1.5.4.1 --- native-gtk-toolbar.c 2005/01/24 23:34:04 1.5 +++ native-gtk-toolbar.c 2005/02/16 00:43:41 1.5.4.1 ＠＠ -152,7 +152,7 ＠＠ /* #### It is currently possible for users to trash us by directly changing the toolbar glyphs. Avoid crashing in that case. */ if (GLYPHP (glyph)) - instance = glyph_image_instance (glyph, window, + instance = glyph_image_instance (glyph, window, button, ERROR_ME_DEBUG_WARN, 1); else instance = Qnil; 1.16.4.1 +7 -5 XEmacs/xemacs/src/objects-gtk.c Index: objects-gtk.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-gtk.c,v retrieving revision 1.16 retrieving revision 1.16.4.1 diff -u -r1.16 -r1.16.4.1 --- objects-gtk.c 2005/01/28 02:58:51 1.16 +++ objects-gtk.c 2005/02/16 00:43:41 1.16.4.1 ＠＠ -495,16 +495,17 ＠＠ gtk_find_charset_font (Lisp_Object device, Lisp_Object font, Lisp_Object charset, int stage) { - char **names; + /* #### copied from x_find_charset_font */ + Extbyte **names; int count = 0; Lisp_Object result = Qnil; - const char *patternext; + const Extbyte *patternext; int i; if (stage) return Qnil; - TO_EXTERNAL_FORMAT (LISP_STRING, font, C_STRING_ALLOCA, patternext, Qbinary); + LISP_STRING_TO_EXTERNAL (font, patternext, Qx_font_name_encoding); names = XListFonts (GDK_DISPLAY (), patternext, MAX_FONT_COUNT, &count); ＠＠ -514,8 +515,9 ＠＠ const Ibyte *intname; Bytecount intlen; - TO_INTERNAL_FORMAT (C_STRING, names[i], ALLOCA, (intname, intlen), - Qctext); + TO_INTERNAL_FORMAT (C_STRING, names[i], + ALLOCA, (intname, intlen), + Qx_font_name_encoding); if (gtk_font_spec_matches_charset (XDEVICE (device), charset, intname, Qnil, 0, -1, 0)) { 1.47.4.1 +1 -1 XEmacs/xemacs/src/objects-msw.c Index: objects-msw.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects-msw.c,v retrieving revision 1.47 retrieving revision 1.47.4.1 diff -u -r1.47 -r1.47.4.1 --- objects-msw.c 2005/01/28 02:58:51 1.47 +++ objects-msw.c 2005/02/16 00:43:41 1.47.4.1 ＠＠ -2315,7 +2315,7 ＠＠ { #ifdef MULE Vfont_signature_data = - make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); + make_lisp_hash_table (100, hash_table_non_weak, HASH_TABLE_EQUAL); staticpro (&Vfont_signature_data); #endif /* MULE */ } 1.27.4.1 +3 -3 XEmacs/xemacs/src/objects.c Index: objects.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/objects.c,v retrieving revision 1.27 retrieving revision 1.27.4.1 diff -u -r1.27 -r1.27.4.1 --- objects.c 2005/02/03 16:14:07 1.27 +++ objects.c 2005/02/16 00:43:42 1.27.4.1 ＠＠ -773,9 +773,9 ＠＠ { /* Note that the following tables are bi-level. */ d->charset_font_cache_stage_1 = - make_lisp_hash_table (20, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (20, hash_table_non_weak, HASH_TABLE_EQ); d->charset_font_cache_stage_2 = - make_lisp_hash_table (20, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (20, hash_table_non_weak, HASH_TABLE_EQ); } void ＠＠ -862,7 +862,7 ＠＠ if (UNBOUNDP (hash_table)) { /* need to make a sub hash table. */ - hash_table = make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK, + hash_table = make_lisp_hash_table (20, hash_table_key_weak, HASH_TABLE_EQUAL); Fputhash (charset, hash_table, cache); } 1.52.4.1 +5 -4 XEmacs/xemacs/src/print.c Index: print.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/print.c,v retrieving revision 1.52 retrieving revision 1.52.4.1 diff -u -r1.52 -r1.52.4.1 --- print.c 2005/01/24 23:34:05 1.52 +++ print.c 2005/02/16 00:43:42 1.52.4.1 ＠＠ -508,7 +508,7 ＠＠ { for (iii = ccoff; iii < cclen + ccoff; iii++) { - call1 (function, make_char (string_ichar (reloc, iii))); + call1 (function, make_char (string_ichar_at (reloc, iii))); if (STRINGP (reloc)) newnonreloc = XSTRING_DATA (reloc); } ＠＠ -799,6 +799,7 ＠＠ If variable `temp-buffer-show-function' is non-nil, call it at the end to get the buffer displayed. It gets one argument, the buffer to display. */ + /* (BUFNAME &rest BODY) */ (args)) { /* This function can GC */ ＠＠ -1402,7 +1403,7 ＠＠ write_c_string (printcharfun, "\""); for (i = 0; i < bcmax; i++) { - Ibyte ch = string_byte (obj, i); + Ibyte ch = string_byte_at (obj, i); if (ch == '\"' || ch == '\\' || (ch == '\n' && print_escape_newlines)) { ＠＠ -1421,7 +1422,7 ＠＠ write_c_string (printcharfun, "\\"); /* This is correct for Mule because the character is either \ or " */ - temp[0] = string_byte (obj, i); + temp[0] = string_byte_at (obj, i); temp[1] = '\0'; write_string (printcharfun, temp); } ＠＠ -1861,7 +1862,7 ＠＠ for (i = 0; i < size; i++) { - switch (string_byte (name, i)) + switch (string_byte_at (name, i)) { case 0: case 1: case 2: case 3: case 4: case 5: case 6: case 7: 1.57.4.1 +1 -1 XEmacs/xemacs/src/process-unix.c Index: process-unix.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/process-unix.c,v retrieving revision 1.57 retrieving revision 1.57.4.1 diff -u -r1.57 -r1.57.4.1 --- process-unix.c 2005/02/04 04:06:34 1.57 +++ process-unix.c 2005/02/16 00:43:43 1.57.4.1 ＠＠ -1438,7 +1438,7 ＠＠ { if (!NILP (p->pipe_instream)) { - /* We can't just call event_stream->unselect_process_cb (p) + /* We can't just call event_stream->unselect_process (p) here, because that calls XtRemoveInput, which is not necessarily reentrant, so we can't call this at interrupt level. 1.66.4.1 +7 -7 XEmacs/xemacs/src/process.c Index: process.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/process.c,v retrieving revision 1.66 retrieving revision 1.66.4.1 diff -u -r1.66 -r1.66.4.1 --- process.c 2005/01/24 23:34:06 1.66 +++ process.c 2005/02/16 00:43:43 1.66.4.1 ＠＠ -108,7 +108,7 ＠＠ /* Nonzero means delete a process right away if it exits. */ int delete_exited_processes; -/* Hash table which maps USIDs as returned by create_io_streams_cb to +/* Hash table which maps USIDs as returned by create_io_streams to process objects. Processes are not GC-protected through this! */ struct hash_table *usid_to_process; ＠＠ -638,7 +638,6 ＠＠ Lisp callers should use `start-process' instead. Returns the process object for it. -Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS NAME is name for process. It is modified if necessary to make it unique. BUFFER is the buffer or (buffer-name) to associate with the process. Process output goes at end of that buffer, unless you specify ＠＠ -664,6 +663,7 ＠＠ See also `set-process-filter' and `set-process-stderr-filter'. */ + /* (NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */ (int nargs, Lisp_Object *args)) { /* This function can call lisp */ ＠＠ -735,9 +735,9 ＠＠ #endif /* 0 */ /* If program file name is not absolute, search our path for it */ - if (!IS_DIRECTORY_SEP (string_byte (program, 0)) + if (!IS_DIRECTORY_SEP (string_byte_at (program, 0)) && !(XSTRING_LENGTH (program) > 1 - && IS_DEVICE_SEP (string_byte (program, 1)))) + && IS_DEVICE_SEP (string_byte_at (program, 1)))) { struct gcpro ngcpro1; ＠＠ -1587,7 +1587,7 ＠＠ else string2 = build_string ("\n"); set_string_char (string, 0, - DOWNCASE (0, string_ichar (string, 0))); + DOWNCASE (0, string_ichar_at (string, 0))); return concat2 (string, string2); } else if (EQ (symbol, Qexit)) ＠＠ -2275,7 +2275,7 ＠＠ if (STRINGP (entry) && XSTRING_LENGTH (entry) > varlen - && string_byte (entry, varlen) == '=' + && string_byte_at (entry, varlen) == '=' #ifdef WIN32_NATIVE /* NT environment variables are case insensitive. */ && ! memicmp (XSTRING_DATA (entry), var, varlen) ＠＠ -2309,7 +2309,7 ＠＠ if (STRINGP (entry) && XSTRING_LENGTH (entry) > varlen - && string_byte (entry, varlen) == '=' + && string_byte_at (entry, varlen) == '=' #ifdef WIN32_NATIVE /* NT environment variables are case insensitive. */ && ! memicmp (XSTRING_DATA (entry), var, varlen) 1.24.4.1 +9 -7 XEmacs/xemacs/src/profile.c Index: profile.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/profile.c,v retrieving revision 1.24 retrieving revision 1.24.4.1 diff -u -r1.24 -r1.24.4.1 --- profile.c 2005/02/03 16:14:08 1.24 +++ profile.c 2005/02/16 00:43:44 1.24.4.1 ＠＠ -1,5 +1,5 ＠＠ /* Why the hell is XEmacs so fucking slow? - Copyright (C) 1996, 2002, 2003, 2004 Ben Wing. + Copyright (C) 1996, 2002, 2003, 2004, 2005 Ben Wing. Copyright (C) 1998 Free Software Foundation, Inc. This file is part of XEmacs. ＠＠ -137,16 +137,16 ＠＠ create_timing_profile_table (); if (NILP (Vtotal_timing_profile_table)) Vtotal_timing_profile_table = - make_lisp_hash_table (1000, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (1000, hash_table_non_weak, HASH_TABLE_EQ); if (NILP (Vcall_count_profile_table)) Vcall_count_profile_table = - make_lisp_hash_table (1000, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (1000, hash_table_non_weak, HASH_TABLE_EQ); if (NILP (Vgc_usage_profile_table)) Vgc_usage_profile_table = - make_lisp_hash_table (1000, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (1000, hash_table_non_weak, HASH_TABLE_EQ); if (NILP (Vtotal_gc_usage_profile_table)) Vtotal_gc_usage_profile_table = - make_lisp_hash_table (1000, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (1000, hash_table_non_weak, HASH_TABLE_EQ); } static Lisp_Object ＠＠ -474,7 +474,7 ＠＠ copy_hash_table_or_blank (Lisp_Object table) { return !NILP (table) ? Fcopy_hash_table (table) : - make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, + make_lisp_hash_table (100, hash_table_non_weak, HASH_TABLE_EQ); } ＠＠ -514,7 +514,7 ＠＠ const void *overhead; closure.timing = - make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); + make_lisp_hash_table (100, hash_table_non_weak, HASH_TABLE_EQUAL); if (big_profile_table) { ＠＠ -626,6 +626,8 ＠＠ maphash (mark_profiling_info_maphash, big_profile_table, 0); profiling_lock = 0; } + if (!NILP (Vcall_count_profile_table)) + Fclrhash (Vcall_count_profile_table); } DEFUN ("profiling-active-p", Fprofiling_active_p, 0, 0, 0, /* 1.17.4.1 +184 -1339 XEmacs/xemacs/src/redisplay-gtk.c Index: redisplay-gtk.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/redisplay-gtk.c,v retrieving revision 1.17 retrieving revision 1.17.4.1 diff -u -r1.17 -r1.17.4.1 --- redisplay-gtk.c 2005/01/24 23:34:06 1.17 +++ redisplay-gtk.c 2005/02/16 00:43:45 1.17.4.1 ＠＠ -2,7 +2,7 ＠＠ Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. Copyright (C) 1994 Lucid, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 2002, 2003 Ben Wing. + Copyright (C) 2002, 2003, 2005 Ben Wing. This file is part of XEmacs. ＠＠ -26,7 +26,9 ＠＠ /* Author: Chuck Thompson */ /* Gtk flavor by William Perry */ -/* Lots of work done by Ben Wing for Mule */ +/* Lots of work done by Ben Wing for Mule + Snip, snip, snip June 2002 and most of the code is gone, filtered out + into redisplay-xlike.c. */ #include <config.h> #include "lisp.h" ＠＠ -53,149 +55,9 ＠＠ #include "mule-ccl.h" #endif -#define CONST const +static void gtk_output_shadows (struct frame *f, int x, int y, int width, + int height, int shadow_thickness); -#define EOL_CURSOR_WIDTH 5 - -static void gtk_output_pixmap (struct window *w, - Lisp_Object image_instance, - struct display_box *db, - struct display_glyph_area *dga, - face_index findex, - int cursor_start, - int cursor_width, - int cursor_height, - int bgpixmap); -static void gtk_output_vertical_divider (struct window *w, int clear); -static void gtk_output_blank (struct window *w, struct display_line *dl, - struct rune *rb, int start_pixpos, - int cursor_start, int cursor_width); -static void gtk_output_horizontal_line (struct window *w, - struct display_line *dl, - struct rune *rb); -static void gtk_clear_region (Lisp_Object locale, struct device* d, struct frame* f, - face_index findex, int x, int y, - int width, int height, Lisp_Object fcolor, Lisp_Object bcolor, - Lisp_Object background_pixmap); -static void gtk_output_eol_cursor (struct window *w, struct display_line *dl, - int xpos, face_index findex); -static void gtk_clear_frame (struct frame *f); -static void gtk_clear_frame_windows (Lisp_Object window); -static void gtk_bevel_modeline (struct window *w, struct display_line *dl); - -#if 0 -static void __describe_gc (GdkGC *); -#endif - -struct textual_run -{ - Lisp_Object charset; - unsigned char *ptr; - int len; - int dimension; -}; - -/* Separate out the text in DYN into a series of textual runs of a - particular charset. Also convert the characters as necessary into - the format needed by XDrawImageString(), XDrawImageString16(), et - al. (This means converting to one or two byte format, possibly - tweaking the high bits, and possibly running a CCL program.) You - must pre-allocate the space used and pass it in. (This is done so - you can ALLOCA () the space.) You need to allocate (2 * len) bytes - of TEXT_STORAGE and (len * sizeof (struct textual_run)) bytes of - RUN_STORAGE, where LEN is the length of the dynarr. - - Returns the number of runs actually used. */ - -static int -separate_textual_runs (unsigned char *text_storage, - struct textual_run *run_storage, - CONST Ichar *str, Charcount len) -{ - Lisp_Object prev_charset = Qunbound; /* not Qnil because that is a - possible valid charset when - MULE is not defined */ - int runs_so_far = 0; - int i; -#ifdef MULE - struct ccl_program char_converter; - int need_ccl_conversion = 0; -#endif - - for (i = 0; i < len; i++) - { - Ichar ch = str[i]; - Lisp_Object charset; - int byte1, byte2; - int dimension; - int graphic; - - BREAKUP_ICHAR (ch, charset, byte1, byte2); - dimension = XCHARSET_DIMENSION (charset); - graphic = XCHARSET_GRAPHIC (charset); - - if (!EQ (charset, prev_charset)) - { - run_storage[runs_so_far].ptr = text_storage; - run_storage[runs_so_far].charset = charset; - run_storage[runs_so_far].dimension = dimension; - - if (runs_so_far) - { - run_storage[runs_so_far - 1].len = - text_storage - run_storage[runs_so_far - 1].ptr; - if (run_storage[runs_so_far - 1].dimension == 2) - run_storage[runs_so_far - 1].len >>= 1; - } - runs_so_far++; - prev_charset = charset; -#ifdef MULE - { - Lisp_Object ccl_prog = XCHARSET_CCL_PROGRAM (charset); - need_ccl_conversion = !NILP (ccl_prog); - if (need_ccl_conversion) - setup_ccl_program (&char_converter, ccl_prog); - } -#endif - } - - if (graphic == 0) - { - byte1 &= 0x7F; - byte2 &= 0x7F; - } - else if (graphic == 1) - { - byte1 |= 0x80; - byte2 |= 0x80; - } -#ifdef MULE - if (need_ccl_conversion) - { - char_converter.reg[0] = XCHARSET_ID (charset); - char_converter.reg[1] = byte1; - char_converter.reg[2] = byte2; - ccl_driver (&char_converter, 0, 0, 0, 0, CCL_MODE_ENCODING); - byte1 = char_converter.reg[1]; - byte2 = char_converter.reg[2]; - } -#endif - *text_storage++ = (unsigned char) byte1; - if (dimension == 2) - *text_storage++ = (unsigned char) byte2; - } - - if (runs_so_far) - { - run_storage[runs_so_far - 1].len = - text_storage - run_storage[runs_so_far - 1].ptr; - if (run_storage[runs_so_far - 1].dimension == 2) - run_storage[runs_so_far - 1].len >>= 1; - } - - return runs_so_far; -} - /****************************************************************************/ /* */ /* Gtk output routines */ ＠＠ -209,9 +71,7 ＠＠ struct Lisp_Font_Instance *fi = XFONT_INSTANCE (font_inst); if (!fi->proportional_p) - { return fi->width * run->len; - } else { if (run->dimension == 2) ＠＠ -228,38 +88,9 ＠＠ } } -/* - gtk_text_width - - Given a string and a face, return the string's length in pixels when - displayed in the font associated with the face. - */ - -static int -gtk_text_width (struct frame *UNUSED (f), struct face_cachel *cachel, - CONST Ichar *str, Charcount len) -{ - /* !!#### */ - int width_so_far = 0; - unsigned char *text_storage = (unsigned char *) ALLOCA (2 * len); - struct textual_run *runs = alloca_array (struct textual_run, len); - int nruns; - int i; - - nruns = separate_textual_runs (text_storage, runs, str, len); - - for (i = 0; i < nruns; i++) - width_so_far += gtk_text_width_single_run (cachel, runs + i); - - return width_so_far; -} - /***************************************************************************** gtk_divider_height - Return the height of the horizontal divider. This is a function because - divider_height is a device method. - #### If we add etched horizontal divider lines this will have to get smarter. ****************************************************************************/ ＠＠ -268,273 +99,8 ＠＠ { return 2; } - -/***************************************************************************** - gtk_eol_cursor_width - - Return the width of the end-of-line cursor. This is a function - because eol_cursor_width is a device method. - ****************************************************************************/ -static int -gtk_eol_cursor_width (void) -{ - return EOL_CURSOR_WIDTH; -} - -/***************************************************************************** - gtk_output_display_block - Given a display line, a block number for that start line, output all - runes between start and end in the specified display block. - ****************************************************************************/ -static void -gtk_output_display_block (struct window *w, struct display_line *dl, int block, - int start, int end, int start_pixpos, int cursor_start, - int cursor_width, int cursor_height) -{ - struct frame *f = XFRAME (w->frame); - Ichar_dynarr *buf = Dynarr_new (Ichar); - Lisp_Object window; - - struct display_block *db = Dynarr_atp (dl->display_blocks, block); - rune_dynarr *rba = db->runes; - struct rune *rb; - - int elt = start; - face_index findex; - int xpos, width; - Lisp_Object charset = Qunbound; /* Qnil is a valid charset when - MULE is not defined */ - - window = wrap_window (w); - rb = Dynarr_atp (rba, start); - - if (!rb) - { - /* Nothing to do so don't do anything. */ - return; - } - else - { - findex = rb->findex; - xpos = rb->xpos; - width = 0; - if (rb->type == RUNE_CHAR) - charset = ichar_charset (rb->object.chr.ch); - } - - if (end < 0) - end = Dynarr_length (rba); - Dynarr_reset (buf); - - while (elt < end) - { - rb = Dynarr_atp (rba, elt); - - if (rb->findex == findex && rb->type == RUNE_CHAR - && rb->object.chr.ch != '\n' && rb->cursor_type != CURSOR_ON - && EQ (charset, ichar_charset (rb->object.chr.ch))) - { - Dynarr_add (buf, rb->object.chr.ch); - width += rb->width; - elt++; - } - else - { - if (Dynarr_length (buf)) - { - gtk_output_string (w, dl, buf, xpos, 0, start_pixpos, width, - findex, 0, cursor_start, cursor_width, - cursor_height); - xpos = rb->xpos; - width = 0; - } - Dynarr_reset (buf); - width = 0; - - if (rb->type == RUNE_CHAR) - { - findex = rb->findex; - xpos = rb->xpos; - charset = ichar_charset (rb->object.chr.ch); - - if (rb->cursor_type == CURSOR_ON) - { - if (rb->object.chr.ch == '\n') - { - gtk_output_eol_cursor (w, dl, xpos, findex); - } - else - { - Dynarr_add (buf, rb->object.chr.ch); - gtk_output_string (w, dl, buf, xpos, 0, start_pixpos, - rb->width, findex, 1, - cursor_start, cursor_width, - cursor_height); - Dynarr_reset (buf); - } - - xpos += rb->width; - elt++; - } - else if (rb->object.chr.ch == '\n') - { - /* Clear in case a cursor was formerly here. */ - int height = dl->ascent + dl->descent - dl->clip; - - redisplay_clear_region (window, findex, xpos, dl->ypos - dl->ascent, - rb->width, height); - elt++; - } - } - else if (rb->type == RUNE_BLANK || rb->type == RUNE_HLINE) - { - if (rb->type == RUNE_BLANK) - gtk_output_blank (w, dl, rb, start_pixpos, cursor_start, - cursor_width); - else - { - /* #### Our flagging of when we need to redraw the - modeline shadows sucks. Since RUNE_HLINE is only used - by the modeline at the moment it is a good bet - that if it gets redrawn then we should also - redraw the shadows. This won't be true forever. - We borrow the shadow_thickness_changed flag for - now. */ - w->shadow_thickness_changed = 1; - gtk_output_horizontal_line (w, dl, rb); - } - - elt++; - if (elt < end) - { - rb = Dynarr_atp (rba, elt); - - findex = rb->findex; - xpos = rb->xpos; - } - } - else if (rb->type == RUNE_DGLYPH) - { - Lisp_Object instance; - struct display_box dbox; - struct display_glyph_area dga; - redisplay_calculate_display_boxes (dl, rb->xpos, rb->object.dglyph.xoffset, - rb->object.dglyph.yoffset ,start_pixpos, - rb->width, &dbox, &dga); - - window = wrap_window (w); - instance = glyph_image_instance (rb->object.dglyph.glyph, - window, ERROR_ME_DEBUG_WARN, 1); - findex = rb->findex; - - if (IMAGE_INSTANCEP (instance)) - switch (XIMAGE_INSTANCE_TYPE (instance)) - { - case IMAGE_TEXT: - { - /* #### This is way losing. See the comment in - add_glyph_rune(). */ - Lisp_Object string = - XIMAGE_INSTANCE_TEXT_STRING (instance); - convert_ibyte_string_into_ichar_dynarr - (XSTRING_DATA (string), XSTRING_LENGTH (string), buf); - - gtk_output_string (w, dl, buf, xpos, - rb->object.dglyph.xoffset, - start_pixpos, -1, findex, - (rb->cursor_type == CURSOR_ON), - cursor_start, cursor_width, - cursor_height); - Dynarr_reset (buf); - } - break; - - case IMAGE_MONO_PIXMAP: - case IMAGE_COLOR_PIXMAP: - redisplay_output_pixmap (w, instance, &dbox, &dga, - findex,cursor_start, - cursor_width, cursor_height, 0); - break; - - case IMAGE_POINTER: - ABORT (); - - case IMAGE_WIDGET: - if (EQ (XIMAGE_INSTANCE_WIDGET_TYPE (instance), - Qlayout)) - { - redisplay_output_layout (window, instance, &dbox, - &dga, findex, - cursor_start, cursor_width, - cursor_height); - break; - } - - case IMAGE_SUBWINDOW: - redisplay_output_subwindow (w, instance, &dbox, &dga, - findex, cursor_start, - cursor_width, cursor_height); - break; - - case IMAGE_NOTHING: - /* nothing is as nothing does */ - break; - - default: - ABORT (); - } - - xpos += rb->width; - elt++; - } - else - ABORT (); - } - } - - if (Dynarr_length (buf)) - gtk_output_string (w, dl, buf, xpos, 0, start_pixpos, width, findex, - 0, cursor_start, cursor_width, cursor_height); - - /* #### This is really conditionalized well for optimized - performance. */ - if (dl->modeline - && !EQ (Qzero, w->modeline_shadow_thickness) - && (f->clear - || f->windows_structure_changed - || w->shadow_thickness_changed)) - gtk_bevel_modeline (w, dl); - - Dynarr_free (buf); -} - -/***************************************************************************** - gtk_bevel_modeline - - Draw a 3d border around the modeline on window W. - ****************************************************************************/ -static void -gtk_bevel_modeline (struct window *w, struct display_line *dl) -{ - struct frame *f = XFRAME (w->frame); - int shadow_thickness = MODELINE_SHADOW_THICKNESS (w); - int x,y, width, height; - - x = WINDOW_MODELINE_LEFT (w); - width = WINDOW_MODELINE_RIGHT (w) - x; - y = dl->ypos - dl->ascent - shadow_thickness; - height = dl->ascent + dl->descent + 2 * shadow_thickness; - - gtk_output_shadows (f, x, y, width, height, shadow_thickness); -} - -/***************************************************************************** - gtk_get_gc - - Given a number of parameters return a GC with those properties. - ****************************************************************************/ -GdkGC * +void * gtk_get_gc (struct device *d, Lisp_Object font, Lisp_Object fg, Lisp_Object bg, Lisp_Object bg_pmap, Lisp_Object lwidth) { ＠＠ -563,7 +129,7 ＠＠ { /* #### I fixed once case where this was getting it. It was a bad macro expansion (compiler bug). */ - fprintf (stderr, "Help! gtk_get_gc got a bogus fg value! fg = "); + stderr_out ("Help! gtk_get_gc got a bogus fg value! fg = "); debug_print (fg); fg = Qnil; } ＠＠ -611,430 +177,146 ＠＠ return gc_cache_lookup (DEVICE_GTK_GC_CACHE (d), &gcv, (GdkGCValuesMask) mask); } - -/***************************************************************************** - gtk_output_string - - Given a string and a starting position, output that string in the - given face. If cursor is true, draw a cursor around the string. - Correctly handles multiple charsets in the string. - - The meaning of the parameters is something like this: - - W Window that the text is to be displayed in. - DL Display line that this text is on. The values in the - structure are used to determine the vertical position and - clipping range of the text. - BUF Dynamic array of Ichars specifying what is actually to be - drawn. - XPOS X position in pixels where the text should start being drawn. - XOFFSET Number of pixels to be chopped off the left side of the - text. The effect is as if the text were shifted to the - left this many pixels and clipped at XPOS. - CLIP_START Clip everything left of this X position. - WIDTH Clip everything right of XPOS + WIDTH. - FINDEX Index for the face cache element describing how to display - the text. - CURSOR #### I don't understand this. There's something - strange and overcomplexified with this variable. - Chuck, explain please? - CURSOR_START Starting X position of cursor. - CURSOR_WIDTH Width of cursor in pixels. - CURSOR_HEIGHT Height of cursor in pixels. - Starting Y position of cursor is the top of the text line. - The cursor is drawn sometimes whether or not CURSOR is set. ??? - ****************************************************************************/ -static -void gdk_draw_text_image (GdkDrawable *drawable, - GdkFont *font, - GdkGC *gc, - gint x, - gint y, - const gchar *text, - gint text_length); - -void -gtk_output_string (struct window *w, struct display_line *dl, - Ichar_dynarr *buf, int xpos, int xoffset, int clip_start, - int width, face_index findex, int cursor, - int cursor_start, int cursor_width, int cursor_height) +static void +gtk_set_clip_rectangle (struct frame *f, void *gc, int x, int y, + int width, int height) { - /* !!#### Needs review */ - /* General variables */ - struct frame *f = XFRAME (w->frame); - struct device *d = XDEVICE (f->device); - Lisp_Object device; - Lisp_Object window; - GdkWindow *x_win = GET_GTK_WIDGET_WINDOW (FRAME_GTK_TEXT_WIDGET (f)); + GdkRectangle clip_box; - int clip_end; + clip_box.x = 0; + clip_box.y = 0; + clip_box.width = width; + clip_box.height = height; - /* Cursor-related variables */ - int focus = EQ (w->frame, DEVICE_FRAME_WITH_FOCUS_REAL (d)); - int cursor_clip; - Lisp_Object bar_cursor_value = symbol_value_in_buffer (Qbar_cursor, - WINDOW_BUFFER (w)); - struct face_cachel *cursor_cachel = 0; - - /* Text-related variables */ - Lisp_Object bg_pmap; - GdkGC *bgc, *gc; - int height; - int len = Dynarr_length (buf); - unsigned char *text_storage = (unsigned char *) ALLOCA (2 * len); - struct textual_run *runs = alloca_array (struct textual_run, len); - int nruns; - int i; - struct face_cachel *cachel = WINDOW_FACE_CACHEL (w, findex); + gdk_gc_set_clip_rectangle (gc, &clip_box); + gdk_gc_set_clip_origin (gc, x, y); +} - device = wrap_device (d); - window = wrap_window (w); +static void +gtk_unset_clip_rectangle (struct frame *f, void *gc) +{ + gdk_gc_set_clip_rectangle (gc, NULL); + gdk_gc_set_clip_origin (gc, 0, 0); +} - if (width < 0) - width = gtk_text_width (f, cachel, Dynarr_atp (buf, 0), Dynarr_length (buf)); - height = dl->ascent + dl->descent - dl->clip; - - /* Regularize the variables passed in. */ - - if (clip_start < xpos) - clip_start = xpos; - clip_end = xpos + width; - if (clip_start >= clip_end) - /* It's all clipped out. */ - return; +static void +gtk_draw_rectangle (struct frame *f, void *gc, int filled, int x, int y, + int width, int height) +{ + GdkWindow *x_win = GET_GTK_WIDGET_WINDOW (FRAME_GTK_TEXT_WIDGET (f)); + gdk_draw_rectangle (GDK_DRAWABLE (x_win), (GdkGC *) gc, filled, + x, y, width, height); +} - xpos -= xoffset; +static void +gtk_draw_line (struct frame *f, void *gc, int x1, int y1, int x2, int y2) +{ + GdkWindow *x_win = GET_GTK_WIDGET_WINDOW (FRAME_GTK_TEXT_WIDGET (f)); + gdk_draw_line (GDK_DRAWABLE (x_win), (GdkGC *) gc, x1, y1, x2, y2); +} - nruns = separate_textual_runs (text_storage, runs, Dynarr_atp (buf, 0), - Dynarr_length (buf)); +static int +gtk_get_font_property (Lisp_Object font, enum xlike_font_property prop, + int *value) +{ + GdkFont *gfont = FONT_INSTANCE_GTK_FONT (XFONT_INSTANCE (font)); - cursor_clip = (cursor_start >= clip_start && - cursor_start < clip_end); + /* Cannot get at font properties in Gtk, so we resort to + guessing */ - /* This cursor code is really a mess. */ - if (!NILP (w->text_cursor_visible_p) - && (cursor - || cursor_clip - || (cursor_width - && (cursor_start + cursor_width >= clip_start) - && !NILP (bar_cursor_value)))) + switch (prop) { - /* These have to be in separate statements in order to avoid a - compiler bug. */ - face_index sucks = get_builtin_face_cache_index (w, Vtext_cursor_face); - cursor_cachel = WINDOW_FACE_CACHEL (w, sucks); - - /* We have to reset this since any call to WINDOW_FACE_CACHEL - may cause the cache to resize and any pointers to it to - become invalid. */ - cachel = WINDOW_FACE_CACHEL (w, findex); + case XLIKE_UNDERLINE_POSITION: return 0; + case XLIKE_UNDERLINE_THICKNESS: return 0; + case XLIKE_STRIKEOUT_ASCENT: *value = gfont->ascent; return 1; + case XLIKE_STRIKEOUT_DESCENT: *value = gfont->descent; return 1; + default: ABORT (); return 0; } - - bg_pmap = cachel->background_pixmap; - if (!IMAGE_INSTANCEP (bg_pmap) - || !IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (bg_pmap))) - bg_pmap = Qnil; - - if ((cursor && focus && NILP (bar_cursor_value) - && !NILP (w->text_cursor_visible_p)) || NILP (bg_pmap)) - bgc = 0; - else - bgc = gtk_get_gc (d, Qnil, cachel->foreground, cachel->background, - bg_pmap, Qnil); - - if (bgc) - gdk_draw_rectangle (GDK_DRAWABLE (x_win), bgc, TRUE, clip_start, - dl->ypos - dl->ascent, clip_end - clip_start, - height); - - for (i = 0; i < nruns; i++) - { - Lisp_Object font = FACE_CACHEL_FONT (cachel, runs[i].charset); - struct Lisp_Font_Instance *fi = XFONT_INSTANCE (font); - GdkFont *gdk_font = FONT_INSTANCE_GTK_FONT (fi); - int this_width; - int need_clipping; - - if (EQ (font, Vthe_null_font_instance)) - continue; - - this_width = gtk_text_width_single_run (cachel, runs + i); - need_clipping = (dl->clip || clip_start > xpos || - clip_end < xpos + this_width); - - /* XDrawImageString only clears the area equal to the height of - the given font. It is possible that a font is being displayed - on a line taller than it is, so this would cause us to fail to - clear some areas. */ - if ((int) fi->height < (int) (height + dl->clip)) - { - int clear_start = max (xpos, clip_start); - int clear_end = min (xpos + this_width, clip_end); - - if (cursor) - { - int ypos1_line, ypos1_string, ypos2_line, ypos2_string; - - ypos1_string = dl->ypos - fi->ascent; - ypos2_string = dl->ypos + fi->descent; - ypos1_line = dl->ypos - dl->ascent; - ypos2_line = dl->ypos + dl->descent - dl->clip; - - /* Make sure we don't clear below the real bottom of the - line. */ - if (ypos1_string > ypos2_line) - ypos1_string = ypos2_line; - if (ypos2_string > ypos2_line) - ypos2_string = ypos2_line; - - if (ypos1_line < ypos1_string) - { - redisplay_clear_region (window, findex, clear_start, ypos1_line, - clear_end - clear_start, - ypos1_string - ypos1_line); - } - - if (ypos2_line > ypos2_string) - { - redisplay_clear_region (window, findex, clear_start, ypos2_string, - clear_end - clear_start, - ypos2_line - ypos2_string); - } - } - else - { - redisplay_clear_region (window, findex, clear_start, - dl->ypos - dl->ascent, clear_end - clear_start, - height); - } - } - - if (cursor && cursor_cachel && focus && NILP (bar_cursor_value)) - { - gc = gtk_get_gc (d, font, cursor_cachel->foreground, - cursor_cachel->background, Qnil, Qnil); - } - else - { - gc = gtk_get_gc (d, font, cachel->foreground, cachel->background, - Qnil, Qnil); - } - - if (need_clipping) - { - GdkRectangle clip_box; - - clip_box.x = 0; - clip_box.y = 0; - clip_box.width = clip_end - clip_start; - clip_box.height = height; - - gdk_gc_set_clip_rectangle (gc, &clip_box); - gdk_gc_set_clip_origin (gc, clip_start, dl->ypos - dl->ascent); - } - - /* The X specific called different functions (XDraw*String - vs. XDraw*String16), but apparently gdk_draw_text takes care - of that for us. - - BUT, gdk_draw_text also does too much, by dividing the length - by 2. So we fake them out my multiplying the length by the - dimension of the text. This will do the right thing for - single-dimension runs as well of course. - */ - (bgc ? gdk_draw_text : gdk_draw_text_image) (GDK_DRAWABLE (x_win), gdk_font, gc, xpos, - dl->ypos, (char *) runs[i].ptr, - runs[i].len * runs[i].dimension); - - /* We draw underlines in the same color as the text. */ - if (cachel->underline) - { - int upos, uthick; - - /* Cannot get at font properties in Gtk, so we resort to - guessing */ - upos = dl->descent / 2; - uthick = 1; - - if ((dl->ypos + upos) < (dl->ypos + dl->descent - dl->clip)) - { - if (dl->ypos + upos + uthick > dl->ypos + dl->descent - dl->clip) - uthick = dl->descent - dl->clip - upos; - - if (uthick == 1) - { - gdk_draw_line (GDK_DRAWABLE (x_win), gc, xpos, dl->ypos + upos, - xpos + this_width, dl->ypos + upos); - } - else if (uthick > 1) - { - gdk_draw_rectangle (GDK_DRAWABLE (x_win), gc, TRUE, xpos, - dl->ypos + upos, this_width, uthick); - } - } - } - - if (cachel->strikethru) { - gint ascent,descent,upos, uthick; - GdkFont *gfont = FONT_INSTANCE_GTK_FONT (XFONT_INSTANCE (font)); - - /* Cannot get at font properties in Gtk, so we resort to - guessing */ - - ascent = gfont->ascent; - descent = gfont->descent; - uthick = 1; - - upos = ascent - ((ascent + descent) / 2) + 1; - - /* Generally, upos will be positive (above the baseline),so subtract */ - if (dl->ypos - upos < dl->ypos + dl->descent - dl->clip) - { - if (dl->ypos - upos + uthick > dl->ypos + dl->descent - dl->clip) - uthick = dl->descent - dl->clip + upos; - - if (uthick == 1) - { - gdk_draw_line (GDK_DRAWABLE (x_win), gc, xpos, dl->ypos - upos, - xpos + this_width, dl->ypos - upos); - } - else if (uthick > 1) - { - gdk_draw_rectangle (GDK_DRAWABLE (x_win), gc, TRUE, xpos, dl->ypos + upos, - this_width, uthick); - } - } - } +} - /* Restore the GC */ - if (need_clipping) - { - gdk_gc_set_clip_rectangle (gc, NULL); - gdk_gc_set_clip_origin (gc, 0, 0); - } +/* This makes me feel incredibly dirty... but there is no other way to + get this done right other than calling clear_area before every + single $#!%＠ing piece of text, which I do NOT want to do. */ +#define USE_X_SPECIFIC_DRAW_ROUTINES 1 - /* If we are actually superimposing the cursor then redraw with just - the appropriate section highlighted. */ - if (cursor_clip && !cursor && focus && cursor_cachel) - { - GdkGC *cgc; - GdkRectangle clip_box; +#include <gdk/gdkx.h> - cgc = gtk_get_gc (d, font, cursor_cachel->foreground, - cursor_cachel->background, Qnil, Qnil); +static void +gdk_draw_text_image (GdkDrawable *drawable, + GdkFont *font, + GdkGC *gc, + gint x, + gint y, + const gchar *text, + gint text_length) +{ +#if !USE_X_SPECIFIC_DRAW_ROUTINES + int width = gdk_text_measure (font, text, text_length); + int height = gdk_text_height (font, text, text_length); - clip_box.x = 0; - clip_box.y = 0; - clip_box.width = cursor_width; - clip_box.height = height; - - gdk_gc_set_clip_rectangle (cgc, &clip_box); - gdk_gc_set_clip_origin (cgc, cursor_start, dl->ypos - dl->ascent); - - /* The X specific called different functions (XDraw*String - vs. XDraw*String16), but apparently gdk_draw_text takes care - of that for us. - - BUT, gdk_draw_text also does too much, by dividing the - length by 2. So we fake them out my multiplying the - length by the dimension of the text. This will do the - right thing for single-dimension runs as well of course. - */ - gdk_draw_text_image (GDK_DRAWABLE (x_win), gdk_font, cgc, xpos, - dl->ypos, (char *) runs[i].ptr, - runs[i].len * runs[i].dimension); + gdk_draw_rectangle (drawable, gc, TRUE, x, y, width, height); + gdk_draw_text (drawable, font, gc, x, y, text, text_length); +#else + GdkWindowPrivate *drawable_private; + GdkFontPrivate *font_private; + GdkGCPrivate *gc_private; - gdk_gc_set_clip_rectangle (cgc, NULL); - gdk_gc_set_clip_origin (cgc, 0, 0); - } + g_return_if_fail (drawable != NULL); + g_return_if_fail (font != NULL); + g_return_if_fail (gc != NULL); + g_return_if_fail (text != NULL); - xpos += this_width; - } + drawable_private = (GdkWindowPrivate*) drawable; + if (drawable_private->destroyed) + return; + gc_private = (GdkGCPrivate*) gc; + font_private = (GdkFontPrivate*) font; - /* Draw the non-focus box or bar-cursor as needed. */ - /* Can't this logic be simplified? */ - if (cursor_cachel - && ((cursor && !focus && NILP (bar_cursor_value)) - || (cursor_width - && (cursor_start + cursor_width >= clip_start) - && !NILP (bar_cursor_value)))) + if (font->type == GDK_FONT_FONT) { - int tmp_height, tmp_y; - int bar_width = EQ (bar_cursor_value, Qt) ? 1 : 2; - int need_clipping = (cursor_start < clip_start - || clip_end < cursor_start + cursor_width); - - /* #### This value is correct (as far as I know) because - all of the times we need to draw this cursor, we will - be called with exactly one character, so we know we - can always use runs[0]. - - This is bogus as all hell, however. The cursor handling in - this function is way bogus and desperately needs to be - cleaned up. (In particular, the drawing of the cursor should - really really be separated out of this function. This may be - a bit tricky now because this function itself does way too - much stuff, a lot of which needs to be moved into - redisplay.c) This is the only way to be able to easily add - new cursor types or (e.g.) make the bar cursor be able to - span two characters instead of overlaying just one. */ - int bogusly_obtained_ascent_value = - XFONT_INSTANCE (FACE_CACHEL_FONT (cachel, runs[0].charset))->ascent; - - if (!NILP (bar_cursor_value)) + XFontStruct *xfont = (XFontStruct *) font_private->xfont; + XSetFont(drawable_private->xdisplay, gc_private->xgc, xfont->fid); + if ((xfont->min_byte1 == 0) && (xfont->max_byte1 == 0)) { - gc = gtk_get_gc (d, Qnil, cursor_cachel->background, Qnil, Qnil, - make_int (bar_width)); + XDrawImageString (drawable_private->xdisplay, drawable_private->xwindow, + gc_private->xgc, x, y, text, text_length); } else { - gc = gtk_get_gc (d, Qnil, cursor_cachel->background, - Qnil, Qnil, Qnil); - } - - tmp_y = dl->ypos - bogusly_obtained_ascent_value; - tmp_height = cursor_height; - if (tmp_y + tmp_height > (int) (dl->ypos - dl->ascent + height)) - { - tmp_y = dl->ypos - dl->ascent + height - tmp_height; - if (tmp_y < (int) (dl->ypos - dl->ascent)) - tmp_y = dl->ypos - dl->ascent; - tmp_height = dl->ypos - dl->ascent + height - tmp_y; - } - - if (need_clipping) - { - GdkRectangle clip_box; - clip_box.x = 0; - clip_box.y = 0; - clip_box.width = clip_end - clip_start; - clip_box.height = tmp_height; - - gdk_gc_set_clip_rectangle (gc, &clip_box); - gdk_gc_set_clip_origin (gc, clip_start, tmp_y); + XDrawImageString16 (drawable_private->xdisplay, drawable_private->xwindow, + gc_private->xgc, x, y, (XChar2b *) text, text_length / 2); } + } + else if (font->type == GDK_FONT_FONTSET) + { + XFontSet fontset = (XFontSet) font_private->xfont; + XmbDrawImageString (drawable_private->xdisplay, drawable_private->xwindow, + fontset, gc_private->xgc, x, y, text, text_length); + } + else + g_error("undefined font type\n"); +#endif +} - if (!focus && NILP (bar_cursor_value)) - { - gdk_draw_rectangle (GDK_DRAWABLE (x_win), gc, FALSE, - cursor_start, tmp_y, - cursor_width - 1, tmp_height - 1); - } - else if (focus && !NILP (bar_cursor_value)) - { - gdk_draw_line (GDK_DRAWABLE (x_win), gc, - cursor_start + bar_width - 1, tmp_y, - cursor_start + bar_width - 1, tmp_y + tmp_height - 1); - } +static void +gtk_draw_text (struct frame *f, Lisp_Object font, void *gc, int bgc_present, + int x, int y, unsigned char *ptr, int len, int dimension) +{ + GdkWindow *x_win = GET_GTK_WIDGET_WINDOW (FRAME_GTK_TEXT_WIDGET (f)); - /* Restore the GC */ - if (need_clipping) - { - gdk_gc_set_clip_rectangle (gc, NULL); - gdk_gc_set_clip_origin (gc, 0, 0); - } - } + /* The X specific called different functions (XDraw*String + vs. XDraw*String16), but apparently gdk_draw_text takes care + of that for us. + + BUT, gdk_draw_text also does too much, by dividing the length + by 2. So we fake them out my multiplying the length by the + dimension of the text. This will do the right thing for + single-dimension runs as well of course. + */ + (bgc ? gdk_draw_text : gdk_draw_text_image) + (GDK_DRAWABLE (x_win), FONT_INSTANCE_GTK_FONT (XFONT_INSTANCE (fi)), + gc, x, y, (char *) ptr, len * dimension); } static void ＠＠ -1046,8 +328,36 ＠＠ gint xdest, gint ydest, gint width, - gint height); + gint height) +{ + GdkWindowPrivate *drawable_private; + GdkWindowPrivate *src_private; + GdkGCPrivate *gc_private; + + g_return_if_fail (drawable != NULL); + g_return_if_fail (src != NULL); + g_return_if_fail (gc != NULL); + + drawable_private = (GdkWindowPrivate*) drawable; + src_private = (GdkWindowPrivate*) src; + if (drawable_private->destroyed || src_private->destroyed) + return; + gc_private = (GdkGCPrivate*) gc; + + if (width == -1) + width = src_private->width; + if (height == -1) + height = src_private->height; + XCopyPlane (drawable_private->xdisplay, + src_private->xwindow, + drawable_private->xwindow, + gc_private->xgc, + xsrc, ysrc, + width, height, + xdest, ydest, 1L); +} + static void gtk_output_gdk_pixmap (struct frame *f, struct Lisp_Image_Instance *p, int x, int y, int xoffset, int yoffset, ＠＠ -1075,8 +385,8 ＠＠ gcv.clip_mask = IMAGE_INSTANCE_GTK_MASK (p); gcv.clip_x_origin = x - xoffset; gcv.clip_y_origin = y - yoffset; - pixmap_mask |= (GDK_GC_FUNCTION | GDK_GC_CLIP_MASK | GDK_GC_CLIP_X_ORIGIN | - GDK_GC_CLIP_Y_ORIGIN); + pixmap_mask |= (GDK_GC_FUNCTION | GDK_GC_CLIP_MASK | + GDK_GC_CLIP_X_ORIGIN | GDK_GC_CLIP_Y_ORIGIN); /* Can't set a clip rectangle below because we already have a mask. We could conceivably create a new clipmask by zeroing out everything outside the clip region. Is it worth it? ＠＠ -1117,9 +427,6 ＠＠ struct display_box *db, struct display_glyph_area *dga, face_index findex, - int cursor_start, - int cursor_width, - int cursor_height, int UNUSED (bg_pixmap)) { struct frame *f = XFRAME (w->frame); ＠＠ -1146,28 +453,6 ＠＠ dga->width, dga->height, tmp_fcolor, tmp_bcolor, NULL); } - - /* Draw a cursor over top of the pixmap. */ - if (cursor_width && cursor_height && (cursor_start >= db->xpos) - && !NILP (w->text_cursor_visible_p) - && (cursor_start < (db->xpos + dga->width))) - { - GdkGC *gc; - int focus = EQ (w->frame, DEVICE_FRAME_WITH_FOCUS_REAL (d)); - struct face_cachel *cursor_cachel = - WINDOW_FACE_CACHEL (w, - get_builtin_face_cache_index - (w, Vtext_cursor_face)); - - gc = gtk_get_gc (d, Qnil, cursor_cachel->background, Qnil, Qnil, Qnil); - - if (cursor_width > db->xpos + dga->width - cursor_start) - cursor_width = db->xpos + dga->width - cursor_start; - - gdk_draw_rectangle (GDK_DRAWABLE (x_win), gc, focus ? TRUE : FALSE, - cursor_start, db->ypos, cursor_width, - cursor_height); - } } /***************************************************************************** ＠＠ -1186,7 +471,8 ＠＠ GdkGCValues gcv; unsigned long mask; int x, y1, y2, width, shadow_thickness, spacing, line_width; - face_index div_face = get_builtin_face_cache_index (w, Vvertical_divider_face); + face_index div_face = + get_builtin_face_cache_index (w, Vvertical_divider_face); width = window_divider_width (w); shadow_thickness = XINT (w->vertical_divider_shadow_thickness); ＠＠ -1226,167 +512,15 ＠＠ shadow_thickness); } -/***************************************************************************** - gtk_output_blank - - Output a blank by clearing the area it covers in the foreground color - of its face. - ****************************************************************************/ -static void -gtk_output_blank (struct window *w, struct display_line *dl, struct rune *rb, - int start_pixpos, int cursor_start, int cursor_width) -{ - struct frame *f = XFRAME (w->frame); - struct device *d = XDEVICE (f->device); - - GdkWindow *x_win = GET_GTK_WIDGET_WINDOW (FRAME_GTK_TEXT_WIDGET (f)); - GdkGC *gc; - struct face_cachel *cursor_cachel = - WINDOW_FACE_CACHEL (w, - get_builtin_face_cache_index - (w, Vtext_cursor_face)); - Lisp_Object bg_pmap; - Lisp_Object buffer = WINDOW_BUFFER (w); - Lisp_Object bar_cursor_value = symbol_value_in_buffer (Qbar_cursor, - buffer); - - int x = rb->xpos; - int y = dl->ypos - dl->ascent; - int width = rb->width; - int height = dl->ascent + dl->descent - dl->clip; - - if (start_pixpos > x) - { - if (start_pixpos >= (x + width)) - return; - else - { - width -= (start_pixpos - x); - x = start_pixpos; - } - } - - bg_pmap = WINDOW_FACE_CACHEL_BACKGROUND_PIXMAP (w, rb->findex); - if (!IMAGE_INSTANCEP (bg_pmap) - || !IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (bg_pmap))) - bg_pmap = Qnil; - - if (NILP (bg_pmap)) - gc = gtk_get_gc (d, Qnil, WINDOW_FACE_CACHEL_BACKGROUND (w, rb->findex), - Qnil, Qnil, Qnil); - else - gc = gtk_get_gc (d, Qnil, WINDOW_FACE_CACHEL_FOREGROUND (w, rb->findex), - WINDOW_FACE_CACHEL_BACKGROUND (w, rb->findex), bg_pmap, - Qnil); - - gdk_draw_rectangle (GDK_DRAWABLE (x_win), gc, TRUE, x, y, width, height); - - /* If this rune is marked as having the cursor, then it is actually - representing a tab. */ - if (!NILP (w->text_cursor_visible_p) - && (rb->cursor_type == CURSOR_ON - || (cursor_width - && (cursor_start + cursor_width > x) - && cursor_start < (x + width)))) - { - int cursor_height, cursor_y; - int focus = EQ (w->frame, DEVICE_FRAME_WITH_FOCUS_REAL (d)); - struct Lisp_Font_Instance *fi; - - fi = XFONT_INSTANCE (FACE_CACHEL_FONT - (WINDOW_FACE_CACHEL (w, rb->findex), - Vcharset_ascii)); - - gc = gtk_get_gc (d, Qnil, cursor_cachel->background, Qnil, Qnil, Qnil); - - cursor_y = dl->ypos - fi->ascent; - cursor_height = fi->height; - if (cursor_y + cursor_height > y + height) - cursor_height = y + height - cursor_y; - - if (focus) - { - if (NILP (bar_cursor_value)) - { - gdk_draw_rectangle (GDK_DRAWABLE (x_win), gc, TRUE, - cursor_start, cursor_y, - fi->width, cursor_height); - } - else - { - int bar_width = EQ (bar_cursor_value, Qt) ? 1 : 2; - - gc = gtk_get_gc (d, Qnil, cursor_cachel->background, Qnil, Qnil, - make_int (bar_width)); - gdk_draw_line (GDK_DRAWABLE (x_win), gc, cursor_start + bar_width - 1, - cursor_y, cursor_start + bar_width - 1, - cursor_y + cursor_height - 1); - } - } - else if (NILP (bar_cursor_value)) - { - gdk_draw_rectangle (GDK_DRAWABLE (x_win), gc, FALSE, - cursor_start, cursor_y, - fi->width - 1, cursor_height - 1); - } - } -} - -/***************************************************************************** - gtk_output_horizontal_line - - Output a horizontal line in the foreground of its face. - ****************************************************************************/ static void -gtk_output_horizontal_line (struct window *w, - struct display_line *dl, - struct rune *rb) +gtk_draw_hline (struct frame *f, int x1, int x2, int y, int thickness) { - struct frame *f = XFRAME (w->frame); - struct device *d = XDEVICE (f->device); GtkStyle *style = FRAME_GTK_TEXT_WIDGET (f)->style; - GdkWindow *x_win = GET_GTK_WIDGET_WINDOW (FRAME_GTK_TEXT_WIDGET (f)); - GdkGC *gc; - - int x = rb->xpos; - int width = rb->width; - int height = dl->ascent + dl->descent - dl->clip; - - int ypos1, ypos2, ypos3, ypos4; - - ypos1 = dl->ypos - dl->ascent; - ypos2 = ypos1 + rb->object.hline.yoffset; - ypos3 = ypos2 + rb->object.hline.thickness; - ypos4 = dl->ypos + dl->descent - dl->clip; - - /* First clear the area not covered by the line. */ - if (height - rb->object.hline.thickness > 0) - { - gc = gtk_get_gc (d, Qnil, WINDOW_FACE_CACHEL_FOREGROUND (w, rb->findex), - Qnil, Qnil, Qnil); - - if (ypos2 - ypos1 > 0) - gdk_draw_rectangle (GDK_DRAWABLE (x_win), gc, TRUE, x, ypos1, width, ypos2 - ypos1); - if (ypos4 - ypos3 > 0) - gdk_draw_rectangle (GDK_DRAWABLE (x_win), gc, TRUE, x, ypos1, width, ypos2 - ypos1); - } - gtk_paint_hline (style, x_win, GTK_STATE_NORMAL, NULL, FRAME_GTK_TEXT_WIDGET (f), - "hline", x, x + width, ypos2); -#if 0 - /* Now draw the line. */ - gc = gtk_get_gc (d, Qnil, WINDOW_FACE_CACHEL_BACKGROUND (w, rb->findex), - Qnil, Qnil, Qnil); - - if (ypos2 < ypos1) - ypos2 = ypos1; - if (ypos3 > ypos4) - ypos3 = ypos4; - - if (ypos3 - ypos2 > 0) - gdk_draw_rectangle (GDK_DRAWABLE (x_win), gc, TRUE, x, ypos2, width, ypos3 - ypos2); -#endif + /* #### How does it know to get the thickness right? */ + gtk_paint_hline (style, x_win, GTK_STATE_NORMAL, NULL, + FRAME_GTK_TEXT_WIDGET (f), "hline", x1, x2, y); } /***************************************************************************** ＠＠ -1394,7 +528,7 ＠＠ Draw a shadow around the given area using the standard theme engine routines. ****************************************************************************/ -void +static void gtk_output_shadows (struct frame *f, int x, int y, int width, int height, int shadow_thickness) { ＠＠ -1419,213 +553,11 ＠＠ x, y, width, height); } -/***************************************************************************** - gtk_clear_to_window_end - - Clear the area between ypos1 and ypos2. Each margin area and the - text area is handled separately since they may each have their own - background color. - ****************************************************************************/ -static void -gtk_clear_to_window_end (struct window *w, int ypos1, int ypos2) -{ - int height = ypos2 - ypos1; - - if (height) - { - struct frame *f = XFRAME (w->frame); - Lisp_Object window; - int bflag = (window_needs_vertical_divider (w) ? 0 : 1); - layout_bounds bounds; - - bounds = calculate_display_line_boundaries (w, bflag); - window = wrap_window (w); - - if (window_is_leftmost (w)) - redisplay_clear_region (window, DEFAULT_INDEX, FRAME_LEFT_BORDER_START (f), - ypos1, FRAME_BORDER_WIDTH (f), height); - - if (bounds.left_in - bounds.left_out > 0) - redisplay_clear_region (window, - get_builtin_face_cache_index (w, Vleft_margin_face), - bounds.left_out, ypos1, - bounds.left_in - bounds.left_out, height); - - if (bounds.right_in - bounds.left_in > 0) - redisplay_clear_region (window, DEFAULT_INDEX, bounds.left_in, ypos1, - bounds.right_in - bounds.left_in, height); - - if (bounds.right_out - bounds.right_in > 0) - redisplay_clear_region (window, - get_builtin_face_cache_index (w, Vright_margin_face), - bounds.right_in, ypos1, - bounds.right_out - bounds.right_in, height); - - if (window_is_rightmost (w)) - redisplay_clear_region (window, DEFAULT_INDEX, FRAME_RIGHT_BORDER_START (f), - ypos1, FRAME_BORDER_WIDTH (f), height); - } -} - -/**************************************************************************** - gtk_clear_region - - Clear the area in the box defined by the given parameters using the - given face. - ****************************************************************************/ -static void -gtk_clear_region (Lisp_Object UNUSED (locale), struct device* d, - struct frame* f, face_index UNUSED (findex), int x, int y, - int width, int height, Lisp_Object fcolor, Lisp_Object bcolor, - Lisp_Object background_pixmap) -{ - GdkWindow *x_win; - GdkGC *gc = NULL; - - x_win = GET_GTK_WIDGET_WINDOW (FRAME_GTK_TEXT_WIDGET (f)); - - if (!UNBOUNDP (background_pixmap)) - { - gc = gtk_get_gc (d, Qnil, fcolor, bcolor, background_pixmap, Qnil); - } - - if (gc) - { - gdk_draw_rectangle (GDK_DRAWABLE (x_win), gc,TRUE, - x, y, width, height); - } - else - { - gdk_window_clear_area (x_win, x, y, width, height); - } -} - -/***************************************************************************** - gtk_output_eol_cursor - - Draw a cursor at the end of a line. The end-of-line cursor is - narrower than the normal cursor. - ****************************************************************************/ -static void -gtk_output_eol_cursor (struct window *w, struct display_line *dl, int xpos, - face_index findex) -{ - struct frame *f = XFRAME (w->frame); - struct device *d = XDEVICE (f->device); - Lisp_Object window; - - GdkWindow *x_win = GET_GTK_WIDGET_WINDOW (FRAME_GTK_TEXT_WIDGET (f)); - GdkGC *gc; - face_index elt = get_builtin_face_cache_index (w, Vtext_cursor_face); - struct face_cachel *cursor_cachel = WINDOW_FACE_CACHEL (w, elt); - - int focus = EQ (w->frame, DEVICE_FRAME_WITH_FOCUS_REAL (d)); - Lisp_Object bar_cursor_value = symbol_value_in_buffer (Qbar_cursor, - WINDOW_BUFFER (w)); - - int x = xpos; - int y = dl->ypos - dl->ascent; - int width = EOL_CURSOR_WIDTH; - int height = dl->ascent + dl->descent - dl->clip; - int cursor_height, cursor_y; - int defheight, defascent; - - window = wrap_window (w); - redisplay_clear_region (window, findex, x, y, width, height); - - if (NILP (w->text_cursor_visible_p)) - return; - - gc = gtk_get_gc (d, Qnil, cursor_cachel->background, Qnil, Qnil, Qnil); - - default_face_font_info (window, &defascent, 0, &defheight, 0, 0); - - /* make sure the cursor is entirely contained between y and y+height */ - cursor_height = min (defheight, height); - cursor_y = max (y, min (y + height - cursor_height, - dl->ypos - defascent)); - - if (focus) - { - if (NILP (bar_cursor_value)) - { - gdk_draw_rectangle (GDK_DRAWABLE (x_win), gc, TRUE, x, cursor_y, width, cursor_height); - } - else - { - int bar_width = EQ (bar_cursor_value, Qt) ? 1 : 2; - - gc = gtk_get_gc (d, Qnil, cursor_cachel->background, Qnil, Qnil, - make_int (bar_width)); - gdk_draw_line (GDK_DRAWABLE (x_win), gc, x + bar_width - 1, cursor_y, - x + bar_width - 1, cursor_y + cursor_height - 1); - } - } - else if (NILP (bar_cursor_value)) - { - gdk_draw_rectangle (GDK_DRAWABLE (x_win), gc, FALSE, x, cursor_y, width - 1, - cursor_height - 1); - } -} - -static void -gtk_clear_frame_window (Lisp_Object window) -{ - struct window *w = XWINDOW (window); - - if (!NILP (w->vchild)) - { - gtk_clear_frame_windows (w->vchild); - return; - } - - if (!NILP (w->hchild)) - { - gtk_clear_frame_windows (w->hchild); - return; - } - - gtk_clear_to_window_end (w, WINDOW_TEXT_TOP (w), WINDOW_TEXT_BOTTOM (w)); -} - static void -gtk_clear_frame_windows (Lisp_Object window) +gtk_clear_area (struct frame *f, int x, int y, int width, int height) { - for (; !NILP (window); window = XWINDOW (window)->next) - gtk_clear_frame_window (window); -} - -static void -gtk_clear_frame (struct frame *f) -{ GdkWindow *x_win = GET_GTK_WIDGET_WINDOW (FRAME_GTK_TEXT_WIDGET (f)); - int x, y, width, height; - Lisp_Object frame; - - x = FRAME_LEFT_BORDER_START (f); - width = (FRAME_PIXWIDTH (f) - FRAME_REAL_LEFT_TOOLBAR_WIDTH (f) - - FRAME_REAL_RIGHT_TOOLBAR_WIDTH (f) - - 2 * FRAME_REAL_LEFT_TOOLBAR_BORDER_WIDTH (f) - - 2 * FRAME_REAL_RIGHT_TOOLBAR_BORDER_WIDTH (f)); - /* #### This adjustment by 1 should be being done in the macros. - There is some small differences between when the menubar is on - and off that we still need to deal with. */ - y = FRAME_TOP_BORDER_START (f) - 1; - height = (FRAME_PIXHEIGHT (f) - FRAME_REAL_TOP_TOOLBAR_HEIGHT (f) - - FRAME_REAL_BOTTOM_TOOLBAR_HEIGHT (f) - - 2 * FRAME_REAL_TOP_TOOLBAR_BORDER_WIDTH (f) - - 2 * FRAME_REAL_BOTTOM_TOOLBAR_BORDER_WIDTH (f)) + 1; - gdk_window_clear_area (x_win, x, y, width, height); - - frame = wrap_frame (f); - - if (!UNBOUNDP (FACE_BACKGROUND_PIXMAP (Vdefault_face, frame)) - || !UNBOUNDP (FACE_BACKGROUND_PIXMAP (Vleft_margin_face, frame)) - || !UNBOUNDP (FACE_BACKGROUND_PIXMAP (Vright_margin_face, frame))) - { - gtk_clear_frame_windows (f->root_window); - } } static int ＠＠ -1650,9 +582,11 ＠＠ gcv.function = GDK_XOR; gcv.graphics_exposures = FALSE; gc = gc_cache_lookup (DEVICE_GTK_GC_CACHE (XDEVICE (f->device)), &gcv, - GDK_GC_FOREGROUND | GDK_GC_FUNCTION | GDK_GC_EXPOSURES); + GDK_GC_FOREGROUND | GDK_GC_FUNCTION | + GDK_GC_EXPOSURES); - gdk_draw_rectangle (GDK_DRAWABLE (GET_GTK_WIDGET_WINDOW (FRAME_GTK_SHELL_WIDGET (f))), + gdk_draw_rectangle (GDK_DRAWABLE (GET_GTK_WIDGET_WINDOW + (FRAME_GTK_SHELL_WIDGET (f))), gc, TRUE, w->pixel_left, w->pixel_top, w->pixel_width, w->pixel_height); ＠＠ -1718,120 +652,31 ＠＠ console_type_create_redisplay_gtk (void) { /* redisplay methods */ - CONSOLE_HAS_METHOD (gtk, text_width); - CONSOLE_HAS_METHOD (gtk, output_display_block); + CONSOLE_INHERITS_METHOD (gtk, xlike, text_width); + CONSOLE_INHERITS_METHOD (gtk, xlike, output_string); + CONSOLE_INHERITS_METHOD (gtk, xlike, output_hline); + CONSOLE_INHERITS_METHOD (gtk, xlike, output_blank); + CONSOLE_INHERITS_METHOD (gtk, xlike, output_cursor); + CONSOLE_INHERITS_METHOD (gtk, xlike, eol_cursor_width); + CONSOLE_INHERITS_METHOD (gtk, xlike, clear_region); + CONSOLE_INHERITS_METHOD (gtk, xlike, clear_frame); + CONSOLE_HAS_METHOD (gtk, divider_height); - CONSOLE_HAS_METHOD (gtk, eol_cursor_width); CONSOLE_HAS_METHOD (gtk, output_vertical_divider); - CONSOLE_HAS_METHOD (gtk, clear_to_window_end); - CONSOLE_HAS_METHOD (gtk, clear_region); - CONSOLE_HAS_METHOD (gtk, clear_frame); CONSOLE_HAS_METHOD (gtk, flash); CONSOLE_HAS_METHOD (gtk, ring_bell); CONSOLE_HAS_METHOD (gtk, bevel_area); - CONSOLE_HAS_METHOD (gtk, output_string); CONSOLE_HAS_METHOD (gtk, output_pixmap); -} - -/* This makes me feel incredibly dirty... but there is no other way to - get this done right other than calling clear_area before every - single $#!%＠ing piece of text, which I do NOT want to do. */ -#define USE_X_SPECIFIC_DRAW_ROUTINES 1 - -#include <gdk/gdkx.h> - -static -void gdk_draw_text_image (GdkDrawable *drawable, - GdkFont *font, - GdkGC *gc, - gint x, - gint y, - const gchar *text, - gint text_length) -{ -#if !USE_X_SPECIFIC_DRAW_ROUTINES - int width = gdk_text_measure (font, text, text_length); - int height = gdk_text_height (font, text, text_length); - - gdk_draw_rectangle (drawable, gc, TRUE, x, y, width, height); - gdk_draw_text (drawable, font, gc, x, y, text, text_length); -#else - GdkWindowPrivate *drawable_private; - GdkFontPrivate *font_private; - GdkGCPrivate *gc_private; - - g_return_if_fail (drawable != NULL); - g_return_if_fail (font != NULL); - g_return_if_fail (gc != NULL); - g_return_if_fail (text != NULL); - - drawable_private = (GdkWindowPrivate*) drawable; - if (drawable_private->destroyed) - return; - gc_private = (GdkGCPrivate*) gc; - font_private = (GdkFontPrivate*) font; - - if (font->type == GDK_FONT_FONT) - { - XFontStruct *xfont = (XFontStruct *) font_private->xfont; - XSetFont(drawable_private->xdisplay, gc_private->xgc, xfont->fid); - if ((xfont->min_byte1 == 0) && (xfont->max_byte1 == 0)) - { - XDrawImageString (drawable_private->xdisplay, drawable_private->xwindow, - gc_private->xgc, x, y, text, text_length); - } - else - { - XDrawImageString16 (drawable_private->xdisplay, drawable_private->xwindow, - gc_private->xgc, x, y, (XChar2b *) text, text_length / 2); - } - } - else if (font->type == GDK_FONT_FONTSET) - { - XFontSet fontset = (XFontSet) font_private->xfont; - XmbDrawImageString (drawable_private->xdisplay, drawable_private->xwindow, - fontset, gc_private->xgc, x, y, text, text_length); - } - else - g_error("undefined font type\n"); -#endif -} - -static void -our_draw_bitmap (GdkDrawable *drawable, - GdkGC *gc, - GdkPixmap *src, - gint xsrc, - gint ysrc, - gint xdest, - gint ydest, - gint width, - gint height) -{ - GdkWindowPrivate *drawable_private; - GdkWindowPrivate *src_private; - GdkGCPrivate *gc_private; - g_return_if_fail (drawable != NULL); - g_return_if_fail (src != NULL); - g_return_if_fail (gc != NULL); - - drawable_private = (GdkWindowPrivate*) drawable; - src_private = (GdkWindowPrivate*) src; - if (drawable_private->destroyed || src_private->destroyed) - return; - gc_private = (GdkGCPrivate*) gc; - - if (width == -1) - width = src_private->width; - if (height == -1) - height = src_private->height; - - XCopyPlane (drawable_private->xdisplay, - src_private->xwindow, - drawable_private->xwindow, - gc_private->xgc, - xsrc, ysrc, - width, height, - xdest, ydest, 1L); + /* xlike methods */ + CONSOLE_HAS_METHOD (gtk, text_width_single_run); + CONSOLE_HAS_METHOD (gtk, get_gc); + CONSOLE_HAS_METHOD (gtk, set_clip_rectangle); + CONSOLE_HAS_METHOD (gtk, unset_clip_rectangle); + CONSOLE_HAS_METHOD (gtk, draw_rectangle); + CONSOLE_HAS_METHOD (gtk, draw_hline); + CONSOLE_HAS_METHOD (gtk, draw_line); + CONSOLE_HAS_METHOD (gtk, get_font_property); + CONSOLE_HAS_METHOD (gtk, draw_text); + CONSOLE_HAS_METHOD (gtk, clear_area); } 1.42.4.1 +39 -264 XEmacs/xemacs/src/redisplay-msw.c Index: redisplay-msw.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/redisplay-msw.c,v retrieving revision 1.42 retrieving revision 1.42.4.1 diff -u -r1.42 -r1.42.4.1 --- redisplay-msw.c 2005/01/24 23:34:07 1.42 +++ redisplay-msw.c 2005/02/16 00:43:46 1.42.4.1 ＠＠ -2,7 +2,7 ＠＠ Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. Copyright (C) 1994 Lucid, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 2001, 2002, 2003 Ben Wing. + Copyright (C) 2001, 2002, 2003, 2005 Ben Wing. This file is part of XEmacs. ＠＠ -68,25 +68,25 ＠＠ struct display_box *db, struct display_glyph_area *dga); -typedef struct textual_run +typedef struct msw_textual_run { Lisp_Object charset; /* charset of this run */ WCHAR *ptr; /* pointer to Unicode chars in this run */ int nchars; /* number of internal characters in this run */ int nwchars; /* number of Unicode chars in this run */ -} textual_run; +} msw_textual_run; /* Separate out the text in STR into a series of textual runs of a particular charset. Returns the number of runs actually used. Returns the textual runs (STATICALLY ALLOCATED!) in RUN_STORAGE_PTR. */ static int -separate_textual_runs (textual_run **run_storage_ptr, +separate_textual_runs (msw_textual_run **run_storage_ptr, const Ichar *str, Charcount len) { static WCHAR *ext_storage; static int ext_storage_size; /* in WCHARS! */ - static textual_run *run_storage; + static msw_textual_run *run_storage; static int run_storage_size; int runs_so_far = 0; int runbegin = 0; ＠＠ -123,7 +123,7 ＠＠ memcpy (ext_storage + total_nchars, alloca_ext_storage, nchars * sizeof (WCHAR)); DO_REALLOC (run_storage, run_storage_size, runs_so_far + 1, - textual_run); + msw_textual_run); run_storage[runs_so_far].ptr = ext_storage + total_nchars; run_storage[runs_so_far].charset = prev_charset; run_storage[runs_so_far].nwchars = nchars; ＠＠ -143,7 +143,7 ＠＠ static int mswindows_text_width_single_run (HDC hdc, struct face_cachel *cachel, - textual_run *run) + msw_textual_run *run) { Lisp_Object font_inst = FACE_CACHEL_FONT (cachel, run->charset); SIZE size; ＠＠ -268,9 +268,9 ＠＠ Lisp_Object bg_pmap = WINDOW_FACE_CACHEL_BACKGROUND_PIXMAP (w, rb->findex); - /* Unmap all subwindows in the area we are going to blank. */ - redisplay_unmap_subwindows_maybe (f, rb->xpos, DISPLAY_LINE_YPOS (dl), - rb->width, DISPLAY_LINE_HEIGHT (dl)); + /* Unmap all subcontrols in the area we are going to blank. */ + redisplay_unmap_subcontrols (f, rb->xpos, DISPLAY_LINE_YPOS (dl), + rb->width, DISPLAY_LINE_HEIGHT (dl), Qnil); if (!IMAGE_INSTANCEP (bg_pmap) || !IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (bg_pmap))) ＠＠ -288,8 +288,7 ＠＠ /* blank the background in the appropriate color */ mswindows_update_dc (hdc, cachel->foreground, cachel->background, Qnil); - redisplay_output_pixmap (w, bg_pmap, &db, &dga, rb->findex, - 0, 0, 0, TRUE); + redisplay_output_pixmap (w, bg_pmap, &db, &dga, rb->findex, 0); } else { ＠＠ -315,7 +314,7 ＠＠ int focus = EQ (w->frame, DEVICE_FRAME_WITH_FOCUS_REAL (d)); HDC hdc = get_frame_dc (f, 1); int local_face_index = 0; - textual_run *run; + msw_textual_run *run; int nruns = 0; RECT rect = { xpos, DISPLAY_LINE_YPOS (dl), ＠＠ -324,12 +323,11 ＠＠ Lisp_Object bar = symbol_value_in_buffer (Qbar_cursor, WINDOW_BUFFER (w)); int bar_p = image_p || !NILP (bar); - int cursor_p = !NILP (w->text_cursor_visible_p); - int real_char_p = ch != 0; + int real_char_p = ch >= 0; - /* Unmap all subwindows in the area we are going to blank. */ - redisplay_unmap_subwindows_maybe (f, xpos, DISPLAY_LINE_YPOS (dl), - width, DISPLAY_LINE_HEIGHT (dl)); + /* Unmap all subcontrols in the area we are going to blank. */ + redisplay_unmap_subcontrols (f, xpos, DISPLAY_LINE_YPOS (dl), + width, DISPLAY_LINE_HEIGHT (dl), Qnil); if (real_char_p) { ＠＠ -349,17 +347,13 ＠＠ or when we need to erase the cursor. Output nothing at eol if bar cursor */ local_face_index = get_builtin_face_cache_index (w, Vtext_cursor_face); - color_cachel = WINDOW_FACE_CACHEL (w, ((!cursor_p || bar_p) ? - findex : local_face_index)); + color_cachel = WINDOW_FACE_CACHEL (w, bar_p ? findex : local_face_index); mswindows_update_dc (hdc, color_cachel->foreground, color_cachel->background, Qnil); ExtTextOutW (hdc, xpos, dl->ypos, ETO_OPAQUE|ETO_CLIPPED, &rect, nruns ? run->ptr : NULL, nruns ? run->nwchars : 0, NULL); } - if (!cursor_p) - return; - if (focus && bar_p) { struct face_cachel *cursor_cachel; ＠＠ -439,9 +433,7 ＠＠ static void mswindows_output_string (struct window *w, struct display_line *dl, Ichar_dynarr *buf, int xpos, int xoffset, - int clip_start, int width, face_index findex, - int UNUSED (cursor), int UNUSED (cursor_start), - int UNUSED (cursor_width), int UNUSED (cursor_height)) + int clip_start, int width, face_index findex) { struct frame *f = XFRAME (w->frame); /* struct device *d = XDEVICE (f->device);*/ ＠＠ -449,7 +441,7 ＠＠ HDC hdc = get_frame_dc (f, 1); int clip_end; Lisp_Object bg_pmap; - textual_run *runs; + msw_textual_run *runs; int nruns; int i, height; RECT rect; ＠＠ -465,14 +457,7 ＠＠ assert(width>=0); #endif - /* Regularize the variables passed in. */ - if (clip_start < xpos) - clip_start = xpos; clip_end = xpos + width; - if (clip_start >= clip_end) - /* It's all clipped out. */ - return; - xpos -= xoffset; /* sort out the destination rectangle */ ＠＠ -482,9 +467,10 ＠＠ rect.right = clip_end; rect.bottom = rect.top + height; - /* make sure the area we are about to display is subwindow free. */ - redisplay_unmap_subwindows_maybe (f, clip_start, DISPLAY_LINE_YPOS (dl), - clip_end - clip_start, DISPLAY_LINE_HEIGHT (dl)); + /* make sure the area we are about to display is subcontrol free. */ + redisplay_unmap_subcontrols (f, clip_start, DISPLAY_LINE_YPOS (dl), + clip_end - clip_start, + DISPLAY_LINE_HEIGHT (dl), Qnil); /* output the background pixmap if there is one */ bg_pmap = cachel->background_pixmap; ＠＠ -501,8 +487,7 ＠＠ /* blank the background in the appropriate color */ mswindows_update_dc (hdc, cachel->foreground, cachel->background, Qnil); - redisplay_output_pixmap (w, bg_pmap, &db, &dga, findex, - 0, 0, 0, TRUE); + redisplay_output_pixmap (w, bg_pmap, &db, &dga, findex, 0); /* output pixmap calls this so we have to recall to get correct references */ cachel = WINDOW_FACE_CACHEL (w, findex); ＠＠ -685,9 +670,8 ＠＠ static void mswindows_output_pixmap (struct window *w, Lisp_Object image_instance, struct display_box *db, - struct display_glyph_area *dga, face_index findex, - int UNUSED (cursor_start), int UNUSED (cursor_width), - int UNUSED (cursor_height), int bg_pixmap) + struct display_glyph_area *dga, + face_index findex, int bg_pixmap) { struct frame *f = XFRAME (w->frame); HDC hdc = get_frame_dc (f, 1); ＠＠ -859,14 +843,14 ＠＠ FRAME_MSWINDOWS_DATA (f)->hdwp = 0; } #endif - GdiFlush(); + GdiFlush (); } /* Printer version is more lightweight. */ static void msprinter_frame_output_end (struct frame *UNUSED (f)) { - GdiFlush(); + GdiFlush (); } static int ＠＠ -894,220 +878,6 ＠＠ } /***************************************************************************** - mswindows_output_display_block - - Given a display line, a block number for that start line, output all - runes between start and end in the specified display block. - Ripped off with minimal thought from the corresponding X routine. - ****************************************************************************/ -static void -mswindows_output_display_block (struct window *w, struct display_line *dl, - int block, int start, int end, - int start_pixpos, int cursor_start, - int cursor_width, int cursor_height) -{ - struct frame *f = XFRAME (w->frame); - Ichar_dynarr *buf = Dynarr_new (Ichar); - Lisp_Object window; - - struct display_block *db = Dynarr_atp (dl->display_blocks, block); - rune_dynarr *rba = db->runes; - struct rune *rb; - - int elt = start; - face_index findex; - int xpos, width; - Lisp_Object charset = Qunbound; /* Qnil is a valid charset when - MULE is not defined */ - window = wrap_window (w); - rb = Dynarr_atp (rba, start); - - if (!rb) - /* Nothing to do so don't do anything. */ - return; - - findex = rb->findex; - xpos = rb->xpos; - width = 0; - if (rb->type == RUNE_CHAR) - charset = ichar_charset (rb->object.chr.ch); - - if (end < 0) - end = Dynarr_length (rba); - Dynarr_reset (buf); - - while (elt < end) - { - rb = Dynarr_atp (rba, elt); - - if (rb->findex == findex && rb->type == RUNE_CHAR - && rb->object.chr.ch != '\n' && rb->cursor_type != CURSOR_ON - && EQ (charset, ichar_charset (rb->object.chr.ch))) - { - Dynarr_add (buf, rb->object.chr.ch); - width += rb->width; - elt++; - } - else - { - if (Dynarr_length (buf)) - { - mswindows_output_string (w, dl, buf, xpos, 0, start_pixpos, - width, findex, 0, 0, 0, 0); - xpos = rb->xpos; - width = 0; - } - Dynarr_reset (buf); - width = 0; - - if (rb->type == RUNE_CHAR) - { - findex = rb->findex; - xpos = rb->xpos; - charset = ichar_charset (rb->object.chr.ch); - - if (rb->cursor_type == CURSOR_ON) - { - if (rb->object.chr.ch == '\n') - { - mswindows_output_cursor (w, dl, xpos, cursor_width, - findex, 0, 0); - } - else - { - Dynarr_add (buf, rb->object.chr.ch); - mswindows_output_cursor (w, dl, xpos, cursor_width, - findex, rb->object.chr.ch, 0); - Dynarr_reset (buf); - } - - xpos += rb->width; - elt++; - } - else if (rb->object.chr.ch == '\n') - { - /* Clear in case a cursor was formerly here. */ - redisplay_clear_region (window, findex, xpos, - DISPLAY_LINE_YPOS (dl), - rb->width, DISPLAY_LINE_HEIGHT (dl)); - elt++; - } - } - else if (rb->type == RUNE_BLANK || rb->type == RUNE_HLINE) - { - if (rb->type == RUNE_BLANK) - mswindows_output_blank (w, dl, rb, start_pixpos); - else - { - /* #### Our flagging of when we need to redraw the - modeline shadows sucks. Since RUNE_HLINE is only used - by the modeline at the moment it is a good bet - that if it gets redrawn then we should also - redraw the shadows. This won't be true forever. - We borrow the shadow_thickness_changed flag for - now. */ - w->shadow_thickness_changed = 1; - mswindows_output_hline (w, dl, rb); - } - - if (rb->cursor_type == CURSOR_ON) - mswindows_output_cursor (w, dl, xpos, cursor_width, rb->findex, 0, 0); - - elt++; - if (elt < end) - { - rb = Dynarr_atp (rba, elt); - - findex = rb->findex; - xpos = rb->xpos; - } - } - else if (rb->type == RUNE_DGLYPH) - { - Lisp_Object instance; - struct display_box dbox; - struct display_glyph_area dga; - - redisplay_calculate_display_boxes (dl, rb->xpos, rb->object.dglyph.xoffset, - rb->object.dglyph.yoffset, - start_pixpos, rb->width, &dbox, &dga); - - window = wrap_window (w); - instance = glyph_image_instance (rb->object.dglyph.glyph, - window, ERROR_ME_DEBUG_WARN, 1); - findex = rb->findex; - - if (IMAGE_INSTANCEP (instance)) - { - switch (XIMAGE_INSTANCE_TYPE (instance)) - { - case IMAGE_MONO_PIXMAP: - case IMAGE_COLOR_PIXMAP: - redisplay_output_pixmap (w, instance, &dbox, &dga, findex, - cursor_start, cursor_width, - cursor_height, 0); - if (rb->cursor_type == CURSOR_ON) - mswindows_output_cursor (w, dl, xpos, cursor_width, - findex, 0, 1); - break; - - case IMAGE_WIDGET: - if (EQ (XIMAGE_INSTANCE_WIDGET_TYPE (instance), - Qlayout)) - { - redisplay_output_layout (window, instance, &dbox, &dga, findex, - cursor_start, cursor_width, - cursor_height); - if (rb->cursor_type == CURSOR_ON) - mswindows_output_cursor (w, dl, xpos, cursor_width, - findex, 0, 1); - break; - } - case IMAGE_SUBWINDOW: - redisplay_output_subwindow (w, instance, &dbox, &dga, findex, - cursor_start, cursor_width, - cursor_height); - if (rb->cursor_type == CURSOR_ON) - mswindows_output_cursor (w, dl, xpos, cursor_width, - findex, 0, 1); - break; - - case IMAGE_NOTHING: - /* nothing is as nothing does */ - break; - - case IMAGE_TEXT: - case IMAGE_POINTER: - default: - ABORT (); - } - IMAGE_INSTANCE_OPTIMIZE_OUTPUT - (XIMAGE_INSTANCE (instance)) = 0; - } - xpos += rb->width; - elt++; - } - else - ABORT (); - } - } - - if (Dynarr_length (buf)) - mswindows_output_string (w, dl, buf, xpos, 0, start_pixpos, width, findex, - 0, 0, 0, 0); - - if (dl->modeline - && !EQ (Qzero, w->modeline_shadow_thickness) - && (f->clear - || f->windows_structure_changed - || w->shadow_thickness_changed)) - bevel_modeline (w, dl); - - Dynarr_free (buf); -} - - -/***************************************************************************** mswindows_output_vertical_divider Draw a vertical divider down the right side of the given window. ＠＠ -1132,7 +902,8 ＠＠ rect.top = y1; rect.bottom = y2; mswindows_update_dc (hdc, Qnil, - WINDOW_FACE_CACHEL_BACKGROUND (w, DEFAULT_INDEX), Qnil); + WINDOW_FACE_CACHEL_BACKGROUND (w, DEFAULT_INDEX), + Qnil); rect.right = WINDOW_RIGHT (w); rect.left = rect.right - spacing; ExtTextOutW (hdc, 0, 0, ETO_OPAQUE, &rect, NULL, 0, NULL); ＠＠ -1151,7 +922,7 ＠＠ face_index div_face = get_builtin_face_cache_index (w, Vvertical_divider_face); mswindows_update_dc (hdc, Qnil, - WINDOW_FACE_CACHEL_BACKGROUND (w, div_face), Qnil); + WINDOW_FACE_CACHEL_BACKGROUND (w, div_face), Qnil); ExtTextOutW (hdc, 0, 0, ETO_OPAQUE, &rect, NULL, 0, NULL); } ＠＠ -1177,7 +948,7 ＠＠ { HDC hdc = get_frame_dc (f, 0); int width_so_far = 0; - textual_run *runs; + msw_textual_run *runs; int nruns; int i; ＠＠ -1248,7 +1019,10 ＠＠ { /* redisplay methods - display*/ CONSOLE_HAS_METHOD (mswindows, text_width); - CONSOLE_HAS_METHOD (mswindows, output_display_block); + CONSOLE_HAS_METHOD (mswindows, output_string); + CONSOLE_HAS_METHOD (mswindows, output_blank); + CONSOLE_HAS_METHOD (mswindows, output_hline); + CONSOLE_HAS_METHOD (mswindows, output_cursor); CONSOLE_HAS_METHOD (mswindows, divider_height); CONSOLE_HAS_METHOD (mswindows, eol_cursor_width); CONSOLE_HAS_METHOD (mswindows, output_vertical_divider); ＠＠ -1259,7 +1033,6 ＠＠ CONSOLE_HAS_METHOD (mswindows, flash); CONSOLE_HAS_METHOD (mswindows, ring_bell); CONSOLE_HAS_METHOD (mswindows, bevel_area); - CONSOLE_HAS_METHOD (mswindows, output_string); CONSOLE_HAS_METHOD (mswindows, output_pixmap); #ifdef HAVE_SCROLLBARS CONSOLE_HAS_METHOD (mswindows, redisplay_deadbox); ＠＠ -1268,7 +1041,6 ＠＠ /* redisplay methods - printer */ CONSOLE_HAS_METHOD (msprinter, frame_output_end); CONSOLE_INHERITS_METHOD (msprinter, mswindows, text_width); - CONSOLE_INHERITS_METHOD (msprinter, mswindows, output_display_block); CONSOLE_INHERITS_METHOD (msprinter, mswindows, divider_height); CONSOLE_INHERITS_METHOD (msprinter, mswindows, eol_cursor_width); CONSOLE_INHERITS_METHOD (msprinter, mswindows, output_vertical_divider); ＠＠ -1277,5 +1049,8 ＠＠ CONSOLE_INHERITS_METHOD (msprinter, mswindows, frame_output_begin); CONSOLE_INHERITS_METHOD (msprinter, mswindows, bevel_area); CONSOLE_INHERITS_METHOD (msprinter, mswindows, output_string); + CONSOLE_INHERITS_METHOD (msprinter, mswindows, output_blank); + CONSOLE_INHERITS_METHOD (msprinter, mswindows, output_hline); + CONSOLE_INHERITS_METHOD (msprinter, mswindows, output_cursor); CONSOLE_INHERITS_METHOD (msprinter, mswindows, output_pixmap); } 1.26.4.1 +569 -407 XEmacs/xemacs/src/redisplay-output.c Index: redisplay-output.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/redisplay-output.c,v retrieving revision 1.26 retrieving revision 1.26.4.1 diff -u -r1.26 -r1.26.4.1 --- redisplay-output.c 2005/01/24 23:34:07 1.26 +++ redisplay-output.c 2005/02/16 00:43:46 1.26.4.1 ＠＠ -1,6 +1,6 ＠＠ /* Synchronize redisplay structures and output changes. Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995, 1996, 2002, 2003 Ben Wing. + Copyright (C) 1995, 1996, 2002, 2003, 2005 Ben Wing. Copyright (C) 1996 Chuck Thompson. Copyright (C) 1999, 2002 Andy Piper. ＠＠ -27,7 +27,7 ＠＠ /* Author: Chuck Thompson */ -/* Heavily hacked for modularity, gutter and subwindow support by Andy +/* Heavily hacked for modularity, gutter and subcontrol support by Andy Piper. */ #include <config.h> ＠＠ -38,6 +38,7 ＠＠ #include "frame-impl.h" #include "device-impl.h" #include "glyphs.h" +#include "objects-impl.h" #include "redisplay.h" #include "faces.h" #include "gutter.h" ＠＠ -46,18 +47,31 ＠＠ struct rune *drb); static void redraw_cursor_in_window (struct window *w, int run_end_begin_glyphs); -static void redisplay_output_display_block (struct window *w, struct display_line *dl, - int block, int start, int end, int start_pixpos, - int cursor_start, int cursor_width, - int cursor_height); -static void redisplay_normalize_display_box (struct display_box* dest, - struct display_glyph_area* src); -static int redisplay_display_boxes_in_window_p (struct window* w, - struct display_box* db, - struct display_glyph_area* dga); -static void redisplay_clear_clipped_region (Lisp_Object locale, face_index findex, - struct display_box* dest, - struct display_glyph_area* glyphsrc, +static void redisplay_output_display_block (struct window *w, + struct display_line *dl, + int block, int start, int end, + int start_pixpos); +static void redisplay_output_layout (Lisp_Object domain, + Lisp_Object image_instance, + struct display_box *db, + struct display_glyph_area *dga, + face_index findex); +static void redisplay_output_subcontrol (struct window *w, + Lisp_Object image_instance, + struct display_box *db, + struct display_glyph_area *dga, + face_index findex); +static void redisplay_normalize_display_box (struct display_box *dest, + struct display_glyph_area *src); +static int redisplay_display_boxes_in_window_p (struct window *w, + struct display_box *db, + struct display_glyph_area* + dga); +static void redisplay_clear_clipped_region (Lisp_Object locale, + face_index findex, + struct display_box *dest, + struct display_glyph_area* + glyphsrc, int fullheight_p, Lisp_Object); static void redisplay_redraw_exposed_windows (Lisp_Object window, int x, int y, int width, int height); ＠＠ -255,10 +269,11 ＠＠ like we need yet another change flag that we can set here and then clear in redisplay_output_layout (). */ Lisp_Object window, image; - Lisp_Image_Instance* ii; + Lisp_Image_Instance *ii; window = wrap_window (w); image = glyph_image_instance (crb->object.dglyph.glyph, - window, ERROR_ME_DEBUG_WARN, 1); + window, crb->object.dglyph.matchspec, + ERROR_ME_DEBUG_WARN, 1); if (!IMAGE_INSTANCEP (image)) return 0; ＠＠ -274,7 +289,7 ＠＠ mean, however, that nothing has changed. We therefore need to check the current hash of the glyph against the last recorded display hash and the pending display items. See - update_subwindow (). */ + update_widget () ^^#### which function?. */ if (image_instance_changed (image) || crb->findex != drb->findex || WINDOW_FACE_CACHEL_DIRTY (w, drb->findex)) ＠＠ -447,38 +462,6 ＠＠ } /***************************************************************************** - get_cursor_size_and_location - - Return the information defining the pixel location of the cursor. - ****************************************************************************/ -static void -get_cursor_size_and_location (struct window *w, struct display_block *db, - int cursor_location, - int *cursor_start, int *cursor_width, - int *cursor_height) -{ - struct rune *rb; - Lisp_Object window; - int defheight, defwidth; - - if (Dynarr_length (db->runes) <= cursor_location) - ABORT (); - - window = wrap_window (w); - - rb = Dynarr_atp (db->runes, cursor_location); - *cursor_start = rb->xpos; - - default_face_height_and_width (window, &defheight, &defwidth); - *cursor_height = defheight; - - if (rb->type == RUNE_BLANK) - *cursor_width = defwidth; - else - *cursor_width = rb->width; -} - -/***************************************************************************** compare_display_blocks Given two display blocks, output only those areas where they differ. ＠＠ -486,8 +469,7 ＠＠ static int compare_display_blocks (struct window *w, struct display_line *cdl, struct display_line *ddl, int c_block, int d_block, - int start_pixpos, int cursor_start, int cursor_width, - int cursor_height) + int start_pixpos) { struct frame *f = XFRAME (w->frame); struct display_block *cdb, *ddb; ＠＠ -525,6 +507,18 ＠＠ * 0 to 8, and the new or old cursor loc overlaps this block. * I've replaced it with the more conservative test below. * -dkindred(a)cs.cmu.edu 23-Mar-1997 */ + /* cursor_start/cursor_width formerly were passed in, ultimately + obtained from a call to get_cursor_size_and_location() -- no + longer in existence, now integrated into + redisplay_output_display_block(). There was a lot more of this + bogus cursor-checking in various parts of the code, e.g. in + redisplay_output_display_block() (or rather, its duplicated + equivalent in various device-specific routines), which, in the X + version, did a lot of checking for the cursor even when not told + to display the cursor. It seemed to have something to do with + displaying the bar cursor over two different characters, but it + clearly didn't work. If we want to reimplement it, do it cleanly. + --ben */ && ((cdl->cursor_elt == -1 && ddl->cursor_elt != -1) || (cdl->cursor_elt != -1 && ddl->cursor_elt == -1)) && (ddl->cursor_elt == -1 || ＠＠ -610,9 +604,7 ＠＠ } redisplay_output_display_block (w, ddl, d_block, start_pos, - stop_pos, start_pixpos, - cursor_start, cursor_width, - cursor_height); + stop_pos, start_pixpos); return 1; } ＠＠ -670,7 +662,6 ＠＠ struct display_line *cdl, *ddl; display_block_dynarr *cdba, *ddba; int start_pixpos, end_pixpos; - int cursor_start, cursor_width, cursor_height; int force = (force_start >= 0 || force_end >= 0); int clear_border = 0; ＠＠ -700,28 +691,6 ＠＠ else end_pixpos = ddl->bounds.right_out; - /* Get the cursor parameters. */ - if (ddl->cursor_elt != -1) - { - struct display_block *db; - - /* If the lines cursor parameter is not -1 then it indicates - which rune in the TEXT block contains the cursor. This means - that there must be at least one display block. The TEXT - block, if present, must always be the first display block. */ - assert (Dynarr_length (ddba) != 0); - - db = Dynarr_atp (ddba, 0); - assert (db->type == TEXT); - - get_cursor_size_and_location (w, db, ddl->cursor_elt, &cursor_start, - &cursor_width, &cursor_height); - } - else - { - cursor_start = cursor_width = cursor_height = 0; - } - /* The modeline should only have a single block and it had better be a TEXT block. */ if (ddl->modeline) ＠＠ -731,12 +700,11 ＠＠ if (cdba && !w->shadow_thickness_changed) { must_sync |= compare_display_blocks (w, cdl, ddl, 0, 0, - start_pixpos, 0, 0, 0); + start_pixpos); } else { - redisplay_output_display_block (w, ddl, 0, 0, -1, start_pixpos, - 0, 0, 0); + redisplay_output_display_block (w, ddl, 0, 0, -1, start_pixpos); must_sync = 1; } ＠＠ -857,9 +825,7 ＠＠ (b == old_b || !old_b)) { must_sync |= compare_display_blocks (w, cdl, ddl, old_block, - block, start_pixpos, - cursor_start, cursor_width, - cursor_height); + block, start_pixpos); } else { ＠＠ -888,9 +854,7 ＠＠ must_sync = 1; redisplay_output_display_block (w, ddl, block, first_elt, last_elt, - start_pixpos, - cursor_start, cursor_width, - cursor_height); + start_pixpos); } start_pixpos = next_start_pixpos; ＠＠ -988,10 +952,7 ＠＠ } else { - { - MAYBE_DEVMETH (d, frame_output_begin, (f)); - MAYBE_DEVMETH (d, window_output_begin, (w)); - } + MAYBE_DEVMETH (d, frame_output_begin, (f)); rb->cursor_type = CURSOR_OFF; dl->cursor_elt = -1; output_display_line (w, 0, cla, y, rb->xpos, rb->xpos + rb->width); ＠＠ -1006,10 +967,7 ＠＠ if (w != XWINDOW (FRAME_SELECTED_WINDOW (device_selected_frame (d)))) { if (!no_output_end) - { - MAYBE_DEVMETH (d, window_output_end, (w)); - MAYBE_DEVMETH (d, frame_output_end, (f)); - } + MAYBE_DEVMETH (d, frame_output_end, (f)); return 1; } ＠＠ -1028,10 +986,7 ＠＠ output_display_line (w, 0, cla, y, rb->xpos, rb->xpos + rb->width); if (!no_output_end) - { - MAYBE_DEVMETH (d, window_output_end, (w)); - MAYBE_DEVMETH (d, frame_output_end, (f)); - } + MAYBE_DEVMETH (d, frame_output_end, (f)); return 1; } else ＠＠ -1080,7 +1035,7 ＠＠ && rb->cursor_type != NO_CURSOR && (ADJ_CHARPOS == new_point || (ADJ_ENDPOS && (new_point >= ADJ_CHARPOS) - && (new_point <= ADJ_CHARPOS)))) + && (new_point <= ADJ_ENDPOS)))) { rb->cursor_type = CURSOR_ON; dl->cursor_elt = cur_rb; ＠＠ -1095,10 +1050,7 ＠＠ make_int (ADJ_CHARPOS), w->buffer); if (!no_output_end) - { - MAYBE_DEVMETH (d, window_output_end, (w)); - MAYBE_DEVMETH (d, frame_output_end, (f)); - } + MAYBE_DEVMETH (d, frame_output_end, (f)); return 1; } ＠＠ -1111,10 +1063,7 ＠＠ } if (!no_output_end) - { - MAYBE_DEVMETH (d, window_output_end, (w)); - MAYBE_DEVMETH (d, frame_output_end, (f)); - } + MAYBE_DEVMETH (d, frame_output_end, (f)); return 0; } #undef ADJ_CHARPOS ＠＠ -1169,18 +1118,12 ＠＠ (f, dl->ypos - 1, rb->xpos)); if (run_end_begin_meths) - { - MAYBE_DEVMETH (d, frame_output_begin, (f)); - MAYBE_DEVMETH (d, window_output_begin, (w)); - } + MAYBE_DEVMETH (d, frame_output_begin, (f)); output_display_line (w, 0, dla, y, rb->xpos, rb->xpos + rb->width); if (run_end_begin_meths) - { - MAYBE_DEVMETH (d, window_output_end, (w)); - MAYBE_DEVMETH (d, frame_output_end, (f)); - } + MAYBE_DEVMETH (d, frame_output_end, (f)); } } ＠＠ -1205,6 +1148,49 ＠＠ redraw_cursor_in_window (XWINDOW (window), run_end_begin_meths); } +/***************************************************************************** + redisplay_output_string + + Given a string and a starting position, output that string in the + given face. Correctly handles multiple charsets in the string. + + The meaning of the parameters is something like this: + + W Window that the text is to be displayed in. + DL Display line that this text is on. The values in the + structure are used to determine the vertical position and + clipping range of the text. + BUF Dynamic array of Ichars specifying what is actually to be + drawn. + XPOS X position in pixels where the text should start being drawn. + XOFFSET Number of pixels to be chopped off the left side of the + text. The effect is as if the text were shifted to the + left this many pixels and clipped at XPOS. + CLIP_START Clip everything left of this X position. + WIDTH Clip everything right of XPOS + WIDTH. + FINDEX Index for the face cache element describing how to display + the text. + ****************************************************************************/ + +static void +redisplay_output_string (struct window *w, struct display_line *dl, + Ichar_dynarr *buf, int xpos, int xoffset, + int clip_start, int width, face_index findex) +{ + int clip_end; + + if (clip_start < xpos) + clip_start = xpos; + clip_end = xpos + width; + if (clip_start >= clip_end) + /* It's all clipped out. */ + return; + + MAYBE_DEVMETH (WINDOW_XDEVICE (w), output_string, + (w, dl, buf, xpos, xoffset, clip_start, width, findex)); +} + + /**************************************************************************** redisplay_output_display_block ＠＠ -1212,113 +1198,289 ＠＠ runes between start and end in the specified display block. ****************************************************************************/ static void -redisplay_output_display_block (struct window *w, struct display_line *dl, int block, - int start, int end, int start_pixpos, int cursor_start, - int cursor_width, int cursor_height) +redisplay_output_display_block (struct window *w, struct display_line *dl, + int block, int start, int end, + int start_pixpos) { +#if 0 + /* #### What's this? It was here prior to abstraction. --ben */ + /* Temporarily disabled until generalization is done. */ + xpos = max (start_pixpos, rb->xpos); + rb = Dynarr_atp (rba, end - 1); + width = rb->xpos + rb->width - xpos; +#endif struct frame *f = XFRAME (w->frame); struct device *d = XDEVICE (f->device); - /* Temporarily disabled until generalization is done. */ -#if 0 + Ichar_dynarr *buf = Dynarr_new (Ichar); + Lisp_Object window = wrap_window (w); struct display_block *db = Dynarr_atp (dl->display_blocks, block); rune_dynarr *rba = db->runes; - struct rune *rb; + struct rune *rb = Dynarr_atp (rba, start); + int elt = start; + face_index findex; int xpos, width; - rb = Dynarr_atp (rba, start); + Lisp_Object charset = Qunbound; /* Qnil is a valid charset when + MULE is not defined */ + int cursor_visible = !NILP (w->text_cursor_visible_p); if (!rb) /* Nothing to do so don't do anything. */ return; - xpos = max (start_pixpos, rb->xpos); + findex = rb->findex; + xpos = rb->xpos; + width = 0; + if (rb->type == RUNE_CHAR) + charset = ichar_charset (rb->object.chr.ch); if (end < 0) end = Dynarr_length (rba); + Dynarr_reset (buf); - rb = Dynarr_atp (rba, end - 1); - width = rb->xpos + rb->width - xpos; + while (elt < end) + { + rb = Dynarr_atp (rba, elt); + + if (rb->findex == findex && rb->type == RUNE_CHAR + && rb->object.chr.ch != '\n' && + (rb->cursor_type != CURSOR_ON || !cursor_visible) + && EQ (charset, ichar_charset (rb->object.chr.ch))) + { + Dynarr_add (buf, rb->object.chr.ch); + width += rb->width; + elt++; + } + else + { + if (Dynarr_length (buf)) + { + redisplay_output_string (w, dl, buf, xpos, 0, start_pixpos, + width, findex); + xpos = rb->xpos; + width = 0; + } + Dynarr_reset (buf); + width = 0; + + if (rb->type == RUNE_CHAR) + { + findex = rb->findex; + xpos = rb->xpos; + charset = ichar_charset (rb->object.chr.ch); + + if (rb->cursor_type == CURSOR_ON && cursor_visible) + { + DEVMETH (d, output_cursor, + (w, dl, xpos, rb->width, findex, + rb->object.chr.ch == '\n' ? -1 : + rb->object.chr.ch, 0)); + + xpos += rb->width; + elt++; + } + else if (rb->object.chr.ch == '\n') + { +#ifdef HAVE_GTK +#error Bill, please fix + /* #### Bill, this was different in the GTK-specific + version. Why???? The same infestation is all throughout + redisplay-gtk.c. Why can't you just use + DISPLAY_LINE_YPOS()/DISPLAY_LINE_HEIGHT() like everyone + else? */ + int height = dl->ascent + dl->descent - dl->clip; + + redisplay_clear_region (window, findex, xpos, dl->ypos - dl->ascent, + rb->width, height); +#else + /* Clear in case a cursor was formerly here. */ + redisplay_clear_region (window, findex, xpos, + DISPLAY_LINE_YPOS (dl), + rb->width, DISPLAY_LINE_HEIGHT (dl)); #endif - /* now actually output the block. */ - DEVMETH (d, output_display_block, (w, dl, block, start, - end, start_pixpos, - cursor_start, cursor_width, - cursor_height)); -} + elt++; + } + } + else if (rb->type == RUNE_BLANK || rb->type == RUNE_HLINE) + { + if (rb->type == RUNE_BLANK) + DEVMETH (d, output_blank, (w, dl, rb, start_pixpos)); + else + { + /* #### Our flagging of when we need to redraw the + modeline shadows sucks. Since RUNE_HLINE is only used + by the modeline at the moment it is a good bet + that if it gets redrawn then we should also + redraw the shadows. This won't be true forever. + We borrow the shadow_thickness_changed flag for + now. */ + w->shadow_thickness_changed = 1; + DEVMETH (d, output_hline, (w, dl, rb)); + } + + if (rb->cursor_type == CURSOR_ON && cursor_visible) + { + int cursor_width = rb->width; + if (rb->type == RUNE_BLANK) + { +#if 1 + /* We used to use the width of the default face, but + I think it's more reasonable to use the width of + the face of the blank. */ + struct face_cachel *cachel = + WINDOW_FACE_CACHEL (w, rb->findex); + Lisp_Font_Instance *fi = + XFONT_INSTANCE (FACE_CACHEL_FONT + (cachel, Vcharset_ascii)); + cursor_width = fi->width; +#else + default_face_height_and_width (wrap_window (w), 0, + &cursor_width); +#endif + } -/**************************************************************************** - redisplay_unmap_subwindows - Remove subwindows from the area in the box defined by the given - parameters. - ****************************************************************************/ -static void -redisplay_unmap_subwindows (struct frame* f, int x, int y, int width, int height, - Lisp_Object ignored_window) -{ - Lisp_Object rest; + DEVMETH (d, output_cursor, (w, dl, xpos, cursor_width, + rb->findex, -1, 0)); + } - LIST_LOOP (rest, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f))) - { - Lisp_Image_Instance *ii = XIMAGE_INSTANCE (XCAR (rest)); - if (IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) - && - IMAGE_INSTANCE_DISPLAY_X (ii) - + IMAGE_INSTANCE_DISPLAY_WIDTH (ii) > x - && - IMAGE_INSTANCE_DISPLAY_X (ii) < x + width - && - IMAGE_INSTANCE_DISPLAY_Y (ii) - + IMAGE_INSTANCE_DISPLAY_HEIGHT (ii) > y - && - IMAGE_INSTANCE_DISPLAY_Y (ii) < y + height - && - !EQ (XCAR (rest), ignored_window)) - { - unmap_subwindow (XCAR (rest)); - } - } -} + elt++; + if (elt < end) + { + rb = Dynarr_atp (rba, elt); -/**************************************************************************** - redisplay_unmap_subwindows_maybe + findex = rb->findex; + xpos = rb->xpos; + } + } + else if (rb->type == RUNE_DGLYPH) + { + Lisp_Object instance; + struct display_box dbox; + struct display_glyph_area dga; + + redisplay_calculate_display_boxes (dl, rb->xpos, + rb->object.dglyph.xoffset, + rb->object.dglyph.yoffset, + start_pixpos, rb->width, + &dbox, &dga); + + window = wrap_window (w); + instance = glyph_image_instance (rb->object.dglyph.glyph, + window, + rb->object.dglyph.matchspec, + ERROR_ME_DEBUG_WARN, 1); + findex = rb->findex; - Potentially subwindows from the area in the box defined by the given - parameters. - ****************************************************************************/ -void -redisplay_unmap_subwindows_maybe (struct frame *f, int x, int y, int width, - int height) -{ - if (!NILP (XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f)))) - { - redisplay_unmap_subwindows (f, x, y, width, height, Qnil); - } -} + if (IMAGE_INSTANCEP (instance)) + { + switch (XIMAGE_INSTANCE_TYPE (instance)) + { + case IMAGE_MONO_PIXMAP: + case IMAGE_COLOR_PIXMAP: + redisplay_output_pixmap (w, instance, &dbox, &dga, + findex, 0); + if (rb->cursor_type == CURSOR_ON && cursor_visible) + DEVMETH (d, output_cursor, (w, dl, xpos, rb->width, + findex, -1, 1)); + break; + + case IMAGE_WIDGET: + if (EQ (XIMAGE_INSTANCE_WIDGET_TYPE (instance), + Qlayout)) + { + redisplay_output_layout (window, instance, &dbox, + &dga, findex); + if (rb->cursor_type == CURSOR_ON && cursor_visible) + DEVMETH (d, output_cursor, (w, dl, xpos, + rb->width, + findex, -1, 1)); + break; + } + /* fall through */ + case IMAGE_SUBWINDOW: + redisplay_output_subcontrol (w, instance, &dbox, &dga, + findex); + if (rb->cursor_type == CURSOR_ON && cursor_visible) + DEVMETH (d, output_cursor, (w, dl, xpos, rb->width, + findex, -1, 1)); + break; + + case IMAGE_NOTHING: + /* nothing is as nothing does */ + break; -static void -redisplay_unmap_subwindows_except_us (struct frame *f, int x, int y, int width, - int height, Lisp_Object subwindow) -{ - if (!NILP (XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f)))) - { - redisplay_unmap_subwindows (f, x, y, width, height, subwindow); + case IMAGE_TEXT: +#ifdef HAVE_GTK +#error Bill, please fix + /* #### Bill, this was different in the GTK-specific + version. Why???? Why do we need this? The other + versions just have an abort() here. I have a feeling + this was a change that was not applied to GTK like it + was elsewhere -- the fatal error in duplicated + code. */ + { + /* #### This is way losing. See the comment in + add_glyph_rune(). */ + Lisp_Object string = + XIMAGE_INSTANCE_TEXT_STRING (instance); + convert_ibyte_string_into_ichar_dynarr + (XSTRING_DATA (string), XSTRING_LENGTH (string), buf); + + gtk_output_string (w, dl, buf, xpos, + rb->object.dglyph.xoffset, + start_pixpos, -1, findex, + (rb->cursor_type == CURSOR_ON && + cursor_visible), + cursor_start, cursor_width, + cursor_height); + Dynarr_reset (buf); + } + break; +#endif + case IMAGE_POINTER: + default: + ABORT (); + } + IMAGE_INSTANCE_OPTIMIZE_OUTPUT + (XIMAGE_INSTANCE (instance)) = 0; + } + xpos += rb->width; + elt++; + } + else + ABORT (); + } } + + if (Dynarr_length (buf)) + redisplay_output_string (w, dl, buf, xpos, 0, start_pixpos, width, + findex); + + /* #### This is really conditionalized well for optimized + performance. */ + if (dl->modeline + && !EQ (Qzero, w->modeline_shadow_thickness) + && (f->clear + || f->windows_structure_changed + || w->shadow_thickness_changed)) + bevel_modeline (w, dl); + + Dynarr_free (buf); } /**************************************************************************** - redisplay_output_subwindow + redisplay_output_subcontrol - output a subwindow. This code borrows heavily from the pixmap stuff, + output a subcontrol. This code borrows heavily from the pixmap stuff, although is much simpler not needing to account for partial pixmaps, backgrounds etc. ****************************************************************************/ -void -redisplay_output_subwindow (struct window *w, - Lisp_Object image_instance, - struct display_box* db, struct display_glyph_area* dga, - face_index findex, int UNUSED (cursor_start), - int UNUSED (cursor_width), - int UNUSED (cursor_height)) +static void +redisplay_output_subcontrol (struct window *w, + Lisp_Object image_instance, + struct display_box *db, + struct display_glyph_area *dga, + face_index findex) { Lisp_Image_Instance *p = XIMAGE_INSTANCE (image_instance); Lisp_Object window; ＠＠ -1328,9 +1490,9 ＠＠ dga->width = IMAGE_INSTANCE_WIDTH (p); /* The first thing we are going to do is update the display - characteristics of the subwindow. This also clears the dirty + characteristics of the subcontrol. This also clears the dirty flags as a side effect. */ - redisplay_subwindow (image_instance); + redisplay_subcontrol (image_instance); /* This makes the glyph area fit into the display area. */ if (!redisplay_normalize_glyph_area (db, dga)) ＠＠ -1338,7 +1500,7 ＠＠ window = wrap_window (w); - /* Clear the area the subwindow is going into. */ + /* Clear the area the subcontrol is going into. */ redisplay_clear_clipped_region (window, findex, db, dga, 0, image_instance); ＠＠ -1348,9 +1510,9 ＠＠ /* if we can't view the whole window we can't view any of it. We have to be careful here since we may be being asked to display - part of a subwindow, the rest of which is on-screen as well. We - need to allow this case and map the entire subwindow. We also - need to be careful since the subwindow could be outside the + part of a subcontrol, the rest of which is on-screen as well. We + need to allow this case and map the entire subcontrol. We also + need to be careful since the subcontrol could be outside the window in the gutter or modeline - we also need to allow these cases.*/ sdga.xoffset = -dga->xoffset; ＠＠ -1360,17 +1522,17 ＠＠ if (redisplay_display_boxes_in_window_p (w, db, &sdga) == 0 || - /* We only want to do full subwindow display for windows that + /* We only want to do full subcontrol display for windows that are completely in the gutter, otherwise we must clip to be safe. */ display_boxes_in_gutter_p (XFRAME (w->frame), db, &sdga) <= 0) { - map_subwindow (image_instance, db->xpos, db->ypos, dga); + map_subcontrol (image_instance, db->xpos, db->ypos, dga); } else { sdga.xoffset = sdga.yoffset = 0; - map_subwindow (image_instance, db->xpos - dga->xoffset, + map_subcontrol (image_instance, db->xpos - dga->xoffset, db->ypos - dga->yoffset, &sdga); } } ＠＠ -1395,25 +1557,26 ＠＠ issues lwlib has to grapple with. We really need to know what has actually changed and make a layout decision based on that. We also really need to know what has changed so that we can only make the - necessary changes in update_subwindow. This has all now been - implemented, Viva la revolution! + necessary changes in update_widget #### which function????. This has + all now been implemented, Viva la revolution! ****************************************************************************/ -void +static void redisplay_output_layout (Lisp_Object domain, Lisp_Object image_instance, - struct display_box* db, struct display_glyph_area* dga, - face_index findex, int UNUSED (cursor_start), - int UNUSED (cursor_width), int UNUSED (cursor_height)) + struct display_box *db, + struct display_glyph_area *dga, + face_index findex) { Lisp_Image_Instance *p = XIMAGE_INSTANCE (image_instance); - Lisp_Object rest, window = DOMAIN_WINDOW (domain); + Lisp_Object window = DOMAIN_WINDOW (domain); Ichar_dynarr *buf = Dynarr_new (Ichar); struct window *w = XWINDOW (window); struct device *d = DOMAIN_XDEVICE (domain); int layout_height, layout_width; - layout_height = glyph_height (image_instance, domain); - layout_width = glyph_width (image_instance, domain); + /* matchspec not used for image instances */ + layout_height = glyph_height (image_instance, domain, Qnil); + layout_width = glyph_width (image_instance, domain, Qnil); dga->height = layout_height; dga->width = layout_width; ＠＠ -1424,8 +1587,10 ＠＠ if (!redisplay_normalize_glyph_area (db, dga)) return; - /* Highly dodgy optimization. We want to only output the whole - layout if we really have to. */ + /* Highly dodgy optimization. We want to only output the whole layout if + we really have to. ^^#### this should just check the dirty flag, + which should always be accurate. We need to fix the places that + change the flags below to update the dirty flag properly. */ if (!IMAGE_INSTANCE_OPTIMIZE_OUTPUT (p) || IMAGE_INSTANCE_LAYOUT_CHANGED (p) || IMAGE_INSTANCE_WIDGET_FACE_CHANGED (p) ＠＠ -1487,139 +1652,144 ＠＠ area. */ redisplay_normalize_display_box (db, dga); - /* Flip through the widgets in the layout displaying as necessary */ - LIST_LOOP (rest, IMAGE_INSTANCE_LAYOUT_CHILDREN (p)) - { - Lisp_Object child = glyph_image_instance (XCAR (rest), image_instance, - ERROR_ME_DEBUG_WARN, 1); + { + /* Flip through the widgets in the layout displaying as necessary */ + LIST_LOOP_2 (child, IMAGE_INSTANCE_LAYOUT_CHILDREN (p)) + { + struct display_box cdb; + Lisp_Image_Instance *childii = XIMAGE_INSTANCE (child); + struct display_glyph_area cdga; + + /* For losing HP-UX */ + cdb.xpos = db->xpos; + cdb.ypos = db->ypos; + cdb.width = db->width; + cdb.height = db->height; + + /* First determine if the image is visible at all */ + + /* The enclosing layout offsets are +ve at this point */ + cdga.xoffset = IMAGE_INSTANCE_XOFFSET (childii) - dga->xoffset; + cdga.yoffset = IMAGE_INSTANCE_YOFFSET (childii) - dga->yoffset; + /* matchspec not used for image instances */ + cdga.width = glyph_width (child, image_instance, Qnil); + cdga.height = glyph_height (child, image_instance, Qnil); + + IMAGE_INSTANCE_OPTIMIZE_OUTPUT (childii) = + IMAGE_INSTANCE_OPTIMIZE_OUTPUT (p); + + /* Although normalization is done by the output routines + we have to do it here so that they don't try and + clear all of db. This is true below also. */ + if (redisplay_normalize_glyph_area (&cdb, &cdga)) + { + redisplay_normalize_display_box (&cdb, &cdga); + /* Since the display boxes will now be totally in the + window if they are visible at all we can now check this + easily. */ + if (cdb.xpos < db->xpos || cdb.ypos < db->ypos + || cdb.xpos + cdb.width > db->xpos + db->width + || cdb.ypos + cdb.height > db->ypos + db->height) + continue; + /* We have to invert the offset here as normalization + will have made them positive which the output + routines will treat as a truly +ve offset. */ + cdga.xoffset = -cdga.xoffset; + cdga.yoffset = -cdga.yoffset; + + switch (IMAGE_INSTANCE_TYPE (childii)) + { + case IMAGE_TEXT: + { + /* #### This is well hacked and could use some + generalisation.*/ + if (redisplay_normalize_glyph_area (&cdb, &cdga) + && + (!IMAGE_INSTANCE_OPTIMIZE_OUTPUT (childii) || + IMAGE_INSTANCE_DIRTYP (childii))) + { + struct display_line dl; /* this is fake */ + Lisp_Object string = + IMAGE_INSTANCE_TEXT_STRING (childii); + unsigned char charsets[NUM_LEADING_BYTES]; + struct face_cachel *cachel = + WINDOW_FACE_CACHEL (w, findex); + + find_charsets_in_ibyte_string + (charsets, + XSTRING_DATA (string), + XSTRING_LENGTH (string)); + ensure_face_cachel_complete (cachel, window, charsets); + + convert_ibyte_string_into_ichar_dynarr + (XSTRING_DATA (string), XSTRING_LENGTH (string), + buf); + + redisplay_normalize_display_box (&cdb, &cdga); + /* Offsets are now +ve again so be careful + when fixing up the display line. */ + xzero (dl); + /* Munge boxes into display lines. */ + dl.ypos = (cdb.ypos - cdga.yoffset) + /* matchspec not used for image instances */ + + glyph_ascent (child, image_instance, Qnil); + dl.ascent = glyph_ascent (child, image_instance, Qnil); + dl.descent = glyph_descent (child, image_instance, Qnil); + dl.top_clip = cdga.yoffset; + dl.clip = (dl.ypos + dl.descent) - + (cdb.ypos + cdb.height); + /* redisplay_output_string doesn't understand + offsets in the same way as other routines - we + have to add the offset to the width so that we + output the full string. */ + redisplay_output_string (w, &dl, buf, cdb.xpos, + cdga.xoffset, cdb.xpos, + cdga.width + cdga.xoffset, + findex); + Dynarr_reset (buf); + } + } + break; - struct display_box cdb; - /* For losing HP-UX */ - cdb.xpos = db->xpos; - cdb.ypos = db->ypos; - cdb.width = db->width; - cdb.height = db->height; - - /* First determine if the image is visible at all */ - if (IMAGE_INSTANCEP (child)) - { - Lisp_Image_Instance* childii = XIMAGE_INSTANCE (child); - - /* The enclosing layout offsets are +ve at this point */ - struct display_glyph_area cdga; - cdga.xoffset = IMAGE_INSTANCE_XOFFSET (childii) - dga->xoffset; - cdga.yoffset = IMAGE_INSTANCE_YOFFSET (childii) - dga->yoffset; - cdga.width = glyph_width (child, image_instance); - cdga.height = glyph_height (child, image_instance); - - IMAGE_INSTANCE_OPTIMIZE_OUTPUT (childii) = - IMAGE_INSTANCE_OPTIMIZE_OUTPUT (p); - - /* Although normalization is done by the output routines - we have to do it here so that they don't try and - clear all of db. This is true below also. */ - if (redisplay_normalize_glyph_area (&cdb, &cdga)) - { - redisplay_normalize_display_box (&cdb, &cdga); - /* Since the display boxes will now be totally in the - window if they are visible at all we can now check this easily. */ - if (cdb.xpos < db->xpos || cdb.ypos < db->ypos - || cdb.xpos + cdb.width > db->xpos + db->width - || cdb.ypos + cdb.height > db->ypos + db->height) - continue; - /* We have to invert the offset here as normalization - will have made them positive which the output - routines will treat as a truly +ve offset. */ - cdga.xoffset = -cdga.xoffset; - cdga.yoffset = -cdga.yoffset; + case IMAGE_MONO_PIXMAP: + case IMAGE_COLOR_PIXMAP: + if (!IMAGE_INSTANCE_OPTIMIZE_OUTPUT (childii) + || IMAGE_INSTANCE_DIRTYP (childii)) + redisplay_output_pixmap (w, child, &cdb, &cdga, findex, + 0); + break; - switch (IMAGE_INSTANCE_TYPE (childii)) - { - case IMAGE_TEXT: + case IMAGE_WIDGET: + if (EQ (IMAGE_INSTANCE_WIDGET_TYPE (childii), Qlayout)) { - /* #### This is well hacked and could use some - generalisation.*/ - if (redisplay_normalize_glyph_area (&cdb, &cdga) - && - (!IMAGE_INSTANCE_OPTIMIZE_OUTPUT (childii) || - IMAGE_INSTANCE_DIRTYP (childii))) - { - struct display_line dl; /* this is fake */ - Lisp_Object string = - IMAGE_INSTANCE_TEXT_STRING (childii); - unsigned char charsets[NUM_LEADING_BYTES]; - struct face_cachel *cachel = WINDOW_FACE_CACHEL (w, findex); - - find_charsets_in_ibyte_string (charsets, - XSTRING_DATA (string), - XSTRING_LENGTH (string)); - ensure_face_cachel_complete (cachel, window, charsets); - - convert_ibyte_string_into_ichar_dynarr - (XSTRING_DATA (string), XSTRING_LENGTH (string), buf); - - redisplay_normalize_display_box (&cdb, &cdga); - /* Offsets are now +ve again so be careful - when fixing up the display line. */ - xzero (dl); - /* Munge boxes into display lines. */ - dl.ypos = (cdb.ypos - cdga.yoffset) - + glyph_ascent (child, image_instance); - dl.ascent = glyph_ascent (child, image_instance); - dl.descent = glyph_descent (child, image_instance); - dl.top_clip = cdga.yoffset; - dl.clip = (dl.ypos + dl.descent) - (cdb.ypos + cdb.height); - /* output_string doesn't understand offsets in - the same way as other routines - we have to - add the offset to the width so that we - output the full string. */ - MAYBE_DEVMETH (d, output_string, (w, &dl, buf, cdb.xpos, - cdga.xoffset, cdb.xpos, - cdga.width + cdga.xoffset, - findex, 0, 0, 0, 0)); - Dynarr_reset (buf); - } + redisplay_output_layout (image_instance, child, &cdb, + &cdga, findex); + break; } - break; + /* fall through */ + case IMAGE_SUBWINDOW: + if (!IMAGE_INSTANCE_OPTIMIZE_OUTPUT (childii) || + IMAGE_INSTANCE_DIRTYP (childii)) + redisplay_output_subcontrol (w, child, &cdb, &cdga, + findex); + break; - case IMAGE_MONO_PIXMAP: - case IMAGE_COLOR_PIXMAP: - if (!IMAGE_INSTANCE_OPTIMIZE_OUTPUT (childii) - || IMAGE_INSTANCE_DIRTYP (childii)) - redisplay_output_pixmap (w, child, &cdb, &cdga, findex, - 0, 0, 0, 0); - break; + case IMAGE_NOTHING: + /* nothing is as nothing does */ + break; - case IMAGE_WIDGET: - if (EQ (IMAGE_INSTANCE_WIDGET_TYPE (childii), Qlayout)) - { - redisplay_output_layout (image_instance, child, &cdb, &cdga, findex, - 0, 0, 0); - break; - } - case IMAGE_SUBWINDOW: - if (!IMAGE_INSTANCE_OPTIMIZE_OUTPUT (childii) || - IMAGE_INSTANCE_DIRTYP (childii)) - redisplay_output_subwindow (w, child, &cdb, &cdga, findex, - 0, 0, 0); - break; - - case IMAGE_NOTHING: - /* nothing is as nothing does */ - break; - - case IMAGE_POINTER: - default: - ABORT (); - } - } - IMAGE_INSTANCE_OPTIMIZE_OUTPUT (childii) = 0; - } - } + case IMAGE_POINTER: + default: + ABORT (); + } + } + IMAGE_INSTANCE_OPTIMIZE_OUTPUT (childii) = 0; + } + } /* Update any display properties. I'm not sure whether this actually does anything for layouts except clear the changed flags. */ - redisplay_subwindow (image_instance); + redisplay_subcontrol (image_instance); Dynarr_free (buf); } ＠＠ -1633,9 +1803,9 ＠＠ void redisplay_output_pixmap (struct window *w, Lisp_Object image_instance, - struct display_box* db, struct display_glyph_area* dga, - face_index findex, int cursor_start, int cursor_width, - int cursor_height, int offset_bitmap) + struct display_box *db, + struct display_glyph_area *dga, + face_index findex, int offset_bitmap) { struct frame *f = XFRAME (w->frame); struct device *d = XDEVICE (f->device); ＠＠ -1686,16 +1856,14 ＠＠ MAYBE_DEVMETH (d, output_pixmap, (w, image_instance, db, dga, - findex, cursor_start, - cursor_width, cursor_height, - offset_bitmap)); + findex, offset_bitmap)); } /**************************************************************************** redisplay_clear_region Clear the area in the box defined by the given parameters using the - given face. This has been generalised so that subwindows can be + given face. This has been generalised so that subcontrols can be coped with effectively. ****************************************************************************/ void ＠＠ -1726,8 +1894,8 ＠＠ d = XDEVICE (f->device); - /* if we have subwindows in the region we have to unmap them */ - redisplay_unmap_subwindows_maybe (f, x, y, width, height); + /* if we have subcontrols in the region we have to unmap them */ + redisplay_unmap_subcontrols (f, x, y, width, height, Qnil); /* #### This isn't quite right for when this function is called from the toolbar code. */ ＠＠ -1803,12 +1971,14 ＠＠ ****************************************************************************/ static void redisplay_clear_clipped_region (Lisp_Object window, face_index findex, - struct display_box* dest, struct display_glyph_area* glyphsrc, - int fullheight_p, Lisp_Object ignored_subwindow) + struct display_box *dest, + struct display_glyph_area *glyphsrc, + int fullheight_p, + Lisp_Object ignored_subcontrol) { /* assume dest->xpos >= 0 */ int clear_x; - struct frame* f = XFRAME (XWINDOW (window)->frame); + struct frame *f = XFRAME (XWINDOW (window)->frame); if (glyphsrc->xoffset > 0) { ＠＠ -1829,11 +1999,11 ＠＠ { int yoffset = (glyphsrc->yoffset > 0 ? glyphsrc->yoffset : 0); - /* We need to make sure that subwindows are unmapped from the + /* We need to make sure that subcontrols are unmapped from the whole area. */ - redisplay_unmap_subwindows_except_us (f, clear_x, dest->ypos, - glyphsrc->width, dest->height, - ignored_subwindow); + redisplay_unmap_subcontrols (f, clear_x, dest->ypos, + glyphsrc->width, dest->height, + ignored_subcontrol); /* first the top box */ if (yoffset > 0) { ＠＠ -1881,8 +2051,8 ＠＠ ****************************************************************************/ int -redisplay_normalize_glyph_area (struct display_box* dest, - struct display_glyph_area* glyphsrc) +redisplay_normalize_glyph_area (struct display_box *dest, + struct display_glyph_area *glyphsrc) { if (dest->xpos + glyphsrc->xoffset > dest->xpos + dest->width || ＠＠ -1957,8 +2127,8 ＠＠ } static void -redisplay_normalize_display_box (struct display_box* dest, - struct display_glyph_area* glyphsrc) +redisplay_normalize_display_box (struct display_box *dest, + struct display_glyph_area *glyphsrc) { /* Adjust the destination area. At the end of this the destination area will exactly enclose the glyph area. The only remaining ＠＠ -2000,9 +2170,9 ＠＠ the display_box is in the window but the display_glyph_area is not. ****************************************************************************/ static int -redisplay_display_boxes_in_window_p (struct window* w, - struct display_box* db, - struct display_glyph_area* dga) +redisplay_display_boxes_in_window_p (struct window *w, + struct display_box *db, + struct display_glyph_area *dga) { int left = WINDOW_TEXT_LEFT (w); int right = WINDOW_TEXT_RIGHT (w); ＠＠ -2036,8 +2206,8 ＠＠ int redisplay_calculate_display_boxes (struct display_line *dl, int xpos, int xoffset, int yoffset, int start_pixpos, - int width, struct display_box* dest, - struct display_glyph_area* src) + int width, struct display_box *dest, + struct display_glyph_area *src) { dest->xpos = xpos; dest->ypos = DISPLAY_LINE_YPOS (dl); ＠＠ -2111,49 +2281,49 ＠＠ redisplay_clear_to_window_end (struct window *w, int ypos1, int ypos2) { struct frame *f = XFRAME (w->frame); - struct device *d = XDEVICE (f->device); - if (HAS_DEVMETH_P (d, clear_to_window_end)) - DEVMETH (d, clear_to_window_end, (w, ypos1, ypos2)); - else - { - int height = ypos2 - ypos1; + int height = ypos2 - ypos1; - if (height) - { - Lisp_Object window; - int bflag = 0 ; /* (window_needs_vertical_divider (w) ? 0 : 1);*/ - layout_bounds bounds; + if (height) + { + Lisp_Object window; +#ifdef HAVE_GTK +#error Bill, GTK used to have a method just like this but with the following +#error line not commented out: +#error Please investigate. + int bflag = (window_needs_vertical_divider (w) ? 0 : 1); +#endif + int bflag = 0 ; /* (window_needs_vertical_divider (w) ? 0 : 1);*/ + layout_bounds bounds; - bounds = calculate_display_line_boundaries (w, bflag); - window = wrap_window (w); + bounds = calculate_display_line_boundaries (w, bflag); + window = wrap_window (w); - if (window_is_leftmost (w)) - redisplay_clear_region (window, DEFAULT_INDEX, FRAME_LEFT_BORDER_START (f), - ypos1, FRAME_BORDER_WIDTH (f), height); + if (window_is_leftmost (w)) + redisplay_clear_region (window, DEFAULT_INDEX, FRAME_LEFT_BORDER_START (f), + ypos1, FRAME_BORDER_WIDTH (f), height); - if (bounds.left_in - bounds.left_out > 0) - redisplay_clear_region (window, - get_builtin_face_cache_index (w, Vleft_margin_face), - bounds.left_out, ypos1, - bounds.left_in - bounds.left_out, height); - - if (bounds.right_in - bounds.left_in > 0) - redisplay_clear_region (window, - DEFAULT_INDEX, - bounds.left_in, ypos1, - bounds.right_in - bounds.left_in, height); - - if (bounds.right_out - bounds.right_in > 0) - redisplay_clear_region (window, - get_builtin_face_cache_index (w, Vright_margin_face), - bounds.right_in, ypos1, - bounds.right_out - bounds.right_in, height); + if (bounds.left_in - bounds.left_out > 0) + redisplay_clear_region (window, + get_builtin_face_cache_index (w, Vleft_margin_face), + bounds.left_out, ypos1, + bounds.left_in - bounds.left_out, height); + + if (bounds.right_in - bounds.left_in > 0) + redisplay_clear_region (window, + DEFAULT_INDEX, + bounds.left_in, ypos1, + bounds.right_in - bounds.left_in, height); + + if (bounds.right_out - bounds.right_in > 0) + redisplay_clear_region (window, + get_builtin_face_cache_index (w, Vright_margin_face), + bounds.right_in, ypos1, + bounds.right_out - bounds.right_in, height); - if (window_is_rightmost (w)) - redisplay_clear_region (window, DEFAULT_INDEX, FRAME_RIGHT_BORDER_START (f), - ypos1, FRAME_BORDER_WIDTH (f), height); - } + if (window_is_rightmost (w)) + redisplay_clear_region (window, DEFAULT_INDEX, FRAME_RIGHT_BORDER_START (f), + ypos1, FRAME_BORDER_WIDTH (f), height); } } ＠＠ -2227,13 +2397,10 ＠＠ int update_values) { struct frame *f = XFRAME (w->frame); - struct device *d = XDEVICE (f->device); display_line_dynarr *cdla = window_display_lines (w, CURRENT_DISP); display_line_dynarr *ddla = window_display_lines (w, DESIRED_DISP); - MAYBE_DEVMETH (d, window_output_begin, (w)); - while (first_line <= last_line) { Charcount old_len = (Dynarr_atp (cdla, first_line)->end_charpos - ＠＠ -2309,7 +2476,7 ＠＠ /* #### See if we can get away with only calling this if max_line_len is greater than the window_char_width. */ /* #### BILL!!! Should we do this for GTK as well? */ -#if defined(HAVE_SCROLLBARS) && defined(HAVE_X_WINDOWS) +#if defined (HAVE_SCROLLBARS) && defined (HAVE_X_WINDOWS) { extern int stupid_vertical_scrollbar_drag_hack; ＠＠ -2319,7 +2486,6 ＠＠ #endif redisplay_redraw_cursor (f, 0); - MAYBE_DEVMETH (d, window_output_end, (w)); } /***************************************************************************** ＠＠ -2432,9 +2598,6 ＠＠ } } - /* Perform any output initialization. */ - MAYBE_DEVMETH (d, window_output_begin, (w)); - /* If the window's structure has changed clear the internal border above it if it is topmost (the function will check). */ if (f->windows_structure_changed || f->faces_changed) ＠＠ -2491,7 +2654,6 ＠＠ INVALIDATE_DEVICE_PIXEL_TO_GLYPH_CACHE (d); redisplay_redraw_cursor (f, 0); - MAYBE_DEVMETH (d, window_output_end, (w)); #ifdef HAVE_SCROLLBARS update_window_scrollbars (w, NULL, !MINI_WINDOW_P (w), 0); 1.25.4.1 +64 -212 XEmacs/xemacs/src/redisplay-tty.c Index: redisplay-tty.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/redisplay-tty.c,v retrieving revision 1.25 retrieving revision 1.25.4.1 diff -u -r1.25 -r1.25.4.1 --- redisplay-tty.c 2005/01/24 23:34:07 1.25 +++ redisplay-tty.c 2005/02/16 00:43:47 1.25.4.1 ＠＠ -1,7 +1,7 ＠＠ /* Communication module for TTY terminals. Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1995, 1996, 2002 Ben Wing. + Copyright (C) 1995, 1996, 2002, 2005 Ben Wing. Copyright (C) 1996 Chuck Thompson. This file is part of XEmacs. ＠＠ -80,16 +80,10 ＠＠ } while (0) #define OUTPUT1_IF(c, a) OUTPUTN_IF (c, a, 1) -static void tty_output_ichar_dynarr (struct window *w, - struct display_line *dl, - Ichar_dynarr *buf, int xpos, - face_index findex, - int cursor); static void tty_output_ibyte_string (struct window *w, struct display_line *dl, Ibyte *str, Bytecount len, - int xpos, face_index findex, - int cursor); + int xpos, face_index findex); static void tty_turn_on_face (struct window *w, face_index findex); static void tty_turn_off_face (struct window *w, face_index findex); static void tty_turn_on_frame_face (struct frame *f, Lisp_Object face); ＠＠ -193,189 +187,73 ＠＠ CONSOLE_TTY_FINAL_CURSOR_Y (c) = y; } -/***************************************************************************** - tty_output_display_block - - Given a display line, a block number for that start line, output all - runes between start and end in the specified display block. - ****************************************************************************/ static void -tty_output_display_block (struct window *w, struct display_line *dl, int block, - int start, int end, int start_pixpos, - int cursor_start, int UNUSED (cursor_width), - int UNUSED (cursor_height)) +tty_output_string (struct window *w, struct display_line *dl, + Ichar_dynarr *buf, int xpos, int xoffset, + int clip_start, int width, face_index findex) { - struct frame *f = XFRAME (w->frame); - Ichar_dynarr *buf = Dynarr_new (Ichar); - - struct display_block *db = Dynarr_atp (dl->display_blocks, block); - rune_dynarr *rba = db->runes; - struct rune *rb; - - int elt = start; - face_index findex; - int xpos; - - rb = Dynarr_atp (rba, elt); - - if (!rb) - { - /* Nothing to do so don't do anything. */ - return; - } - else - { - findex = rb->findex; - xpos = rb->xpos; - } - - if (end < 0) - end = Dynarr_length (rba); + int clip_end = xpos + width; + int i; + int firstxpos = -1; + DECLARE_EISTRING (ei); - Dynarr_reset (buf); + xpos -= xoffset; - while (elt < end && Dynarr_atp (rba, elt)->xpos < start_pixpos) + /* It would be trivial except for clipping. */ + for (i = 0; i < Dynarr_length (buf); i++) { - elt++; - findex = Dynarr_atp (rba, elt)->findex; - xpos = Dynarr_atp (rba, elt)->xpos; - } - - while (elt < end) - { - rb = Dynarr_atp (rba, elt); - - if (rb->findex == findex && rb->type == RUNE_CHAR - && rb->object.chr.ch != '\n' - && (rb->cursor_type != CURSOR_ON - || NILP (w->text_cursor_visible_p))) + Ichar ch = Dynarr_at (buf, i); + int cols = XCHARSET_COLUMNS (ichar_charset (ch)); + if (xpos >= clip_start) { - Dynarr_add (buf, rb->object.chr.ch); - elt++; + if (firstxpos < 0) + firstxpos = xpos; + if (xpos + cols > clip_end) + break; /* we're done */ + else + eicat_ch (ei, ch); } - else - { - if (Dynarr_length (buf)) - { - tty_output_ichar_dynarr (w, dl, buf, xpos, findex, 0); - xpos = rb->xpos; - } - Dynarr_reset (buf); - - if (rb->type == RUNE_CHAR) - { - findex = rb->findex; - xpos = rb->xpos; - - if (rb->object.chr.ch == '\n') - { - /* Clear in case a cursor was formerly here. */ - - Dynarr_add (buf, ' '); - tty_output_ichar_dynarr (w, dl, buf, rb->xpos, - DEFAULT_INDEX, 0); - Dynarr_reset (buf); - - cmgoto (f, dl->ypos - 1, rb->xpos); - - elt++; - } - else if (rb->cursor_type == CURSOR_ON) - { - /* There is not a distinct eol cursor on tty's. */ - - Dynarr_add (buf, rb->object.chr.ch); - tty_output_ichar_dynarr (w, dl, buf, xpos, findex, 0); - Dynarr_reset (buf); - - cmgoto (f, dl->ypos - 1, xpos); - - xpos += rb->width; - elt++; - } - } - /* #### RUNE_HLINE is actually a little more complicated than this - but at the moment it is only used to draw a turned off - modeline and this will suffice for that. */ - else if (rb->type == RUNE_BLANK || rb->type == RUNE_HLINE) - { - Ichar ch_to_add; - int size = rb->width; + xpos += cols; + } - if (rb->type == RUNE_BLANK) - ch_to_add = ' '; - else - ch_to_add = '-'; - - while (size--) - Dynarr_add (buf, ch_to_add); - tty_output_ichar_dynarr (w, dl, buf, rb->xpos, findex, 0); - - if (xpos >= cursor_start - && cursor_start < xpos + Dynarr_length (buf)) - { - cmgoto (f, dl->ypos - 1, cursor_start); - } - - Dynarr_reset (buf); - - elt++; - if (elt < end) - { - rb = Dynarr_atp (rba, elt); - - findex = rb->findex; - xpos = rb->xpos; - } - } - else if (rb->type == RUNE_DGLYPH) - { - Lisp_Object window; - Lisp_Object instance; + tty_output_ibyte_string (w, dl, eidata (ei), eilen (ei), firstxpos, + findex); +} - window = wrap_window (w); - instance = glyph_image_instance (rb->object.dglyph.glyph, - window, ERROR_ME_DEBUG_WARN, 1); - - if (IMAGE_INSTANCEP (instance)) - { - switch (XIMAGE_INSTANCE_TYPE (instance)) - { - case IMAGE_MONO_PIXMAP: - case IMAGE_COLOR_PIXMAP: - case IMAGE_SUBWINDOW: - case IMAGE_WIDGET: - /* just do nothing here */ - break; - - case IMAGE_NOTHING: - /* nothing is as nothing does */ - break; - - case IMAGE_TEXT: - case IMAGE_POINTER: - default: - ABORT (); - } - IMAGE_INSTANCE_OPTIMIZE_OUTPUT - (XIMAGE_INSTANCE (instance)) = 0; - } +static void +tty_output_cursor (struct window *w, struct display_line *dl, int xpos, + int width, face_index findex, Ichar ch, int image_p) +{ + struct frame *f = XFRAME (w->frame); + cmgoto (f, dl->ypos - 1, xpos); +} - xpos += rb->width; - elt++; - } - else - ABORT (); - } - } +static void +tty_output_blank_or_hline (struct window *w, struct display_line *dl, + struct rune *rb, Ibyte ch) +{ + Ibyte *str = alloca_ibytes (rb->width + 1); + int i; - if (Dynarr_length (buf)) - tty_output_ichar_dynarr (w, dl, buf, xpos, findex, 0); - Dynarr_free (buf); + for (i = 0; i < rb->width; i++) + str[i] = ch; + str[i] = '\0'; + tty_output_ibyte_string (w, dl, str, rb->width, rb->xpos, rb->findex); } +static void +tty_output_blank (struct window *w, struct display_line *dl, struct rune *rb, + int start_pixpos) +{ + tty_output_blank_or_hline (w, dl, rb, ' '); +} +static void +tty_output_hline (struct window *w, struct display_line *dl, struct rune *rb) +{ + tty_output_blank_or_hline (w, dl, rb, '-'); +} /***************************************************************************** tty_output_vertical_divider ＠＠ -417,15 +295,14 ＠＠ Clear the area in the box defined by the given parameters. ****************************************************************************/ static void -tty_clear_region (Lisp_Object window, struct device* UNUSED (d), - struct frame * f, face_index findex, int x, int y, - int width, int height, Lisp_Object UNUSED (fcolor), - Lisp_Object UNUSED (bcolor), - Lisp_Object UNUSED (background_pixmap)) +tty_clear_region (Lisp_Object window, struct device *d, struct frame *f, + face_index findex, int x, int y, + int width, int height, Lisp_Object fcolor, Lisp_Object bcolor, + Lisp_Object background_pixmap) { struct console *c = XCONSOLE (FRAME_CONSOLE (f)); int line; - struct window* w = XWINDOW (window); + struct window *w = XWINDOW (window); tty_turn_on_face (w, findex); for (line = y; line < y + height; line++) ＠＠ -529,7 +406,7 ＠＠ static void tty_output_ibyte_string (struct window *w, struct display_line *dl, Ibyte *str, Bytecount len, int xpos, - face_index findex, int UNUSED (cursor)) + face_index findex) { struct frame *f = XFRAME (w->frame); struct console *c = XCONSOLE (FRAME_CONSOLE (f)); ＠＠ -547,34 +424,6 ＠＠ tty_turn_off_face (w, findex); } -static Ibyte_dynarr *tty_output_ichar_dynarr_dynarr; - -/***************************************************************************** - tty_output_ichar_dynarr - - Given a string and a starting position, output that string in the - given face. If cursor is true, draw a cursor around the string. - ****************************************************************************/ -static void -tty_output_ichar_dynarr (struct window *w, struct display_line *dl, - Ichar_dynarr *buf, int xpos, face_index findex, - int cursor) -{ - if (!tty_output_ichar_dynarr_dynarr) - tty_output_ichar_dynarr_dynarr = Dynarr_new (Ibyte); - else - Dynarr_reset (tty_output_ichar_dynarr_dynarr); - - convert_ichar_string_into_ibyte_dynarr (Dynarr_atp (buf, 0), - Dynarr_length (buf), - tty_output_ichar_dynarr_dynarr); - - tty_output_ibyte_string (w, dl, - Dynarr_atp (tty_output_ichar_dynarr_dynarr, 0), - Dynarr_length (tty_output_ichar_dynarr_dynarr), - xpos, findex, cursor); -} - #if 0 static Ibyte_dynarr *sidcs_dynarr; ＠＠ -1498,7 +1347,10 ＠＠ { /* redisplay methods */ CONSOLE_HAS_METHOD (tty, text_width); - CONSOLE_HAS_METHOD (tty, output_display_block); + CONSOLE_HAS_METHOD (tty, output_string); + CONSOLE_HAS_METHOD (tty, output_blank); + CONSOLE_HAS_METHOD (tty, output_hline); + CONSOLE_HAS_METHOD (tty, output_cursor); CONSOLE_HAS_METHOD (tty, output_vertical_divider); CONSOLE_HAS_METHOD (tty, divider_height); CONSOLE_HAS_METHOD (tty, eol_cursor_width); 1.40.4.1 +171 -1200 XEmacs/xemacs/src/redisplay-x.c Index: redisplay-x.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/redisplay-x.c,v retrieving revision 1.40 retrieving revision 1.40.4.1 diff -u -r1.40 -r1.40.4.1 --- redisplay-x.c 2005/01/24 23:34:07 1.40 +++ redisplay-x.c 2005/02/16 00:43:47 1.40.4.1 ＠＠ -2,7 +2,7 ＠＠ Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. Copyright (C) 1994 Lucid, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 2002, 2003 Ben Wing. + Copyright (C) 2002, 2003, 2005 Ben Wing. This file is part of XEmacs. ＠＠ -60,155 +60,42 ＠＠ /* Number of pixels below each line. */ int x_interline_space; /* #### implement me */ -#define EOL_CURSOR_WIDTH 5 +static void x_generate_shadow_pixels (struct frame *f, + unsigned long *top_shadow, + unsigned long *bottom_shadow, + unsigned long background, + unsigned long core_background); +static void x_output_shadows (struct frame *f, int x, int y, int width, + int height, GC top_shadow_gc, + GC bottom_shadow_gc, GC background_gc, + int shadow_thickness, int edges); + +/* Note: We do not use the Xmb*() functions and XFontSets. + Those functions are generally losing for a number of reasons: + + 1) They only support one locale (e.g. you could display + Japanese and ASCII text, but not mixed Japanese/Chinese + text). You could maybe call setlocale() frequently + to try to deal with this, but that would generally + fail because an XFontSet is tied to one locale and + won't have the other character sets in it. + 2) Not all (or even very many) OS's support the useful + locales. For example, as far as I know SunOS and + Solaris only support the Japanese locale if you get the + special Asian-language version of the OS. Yuck yuck + yuck. Linux doesn't support the Japanese locale at + all. + 3) The locale support in X only exists in R5, not in R4. + (Not sure how big of a problem this is: how many + people are using R4?) + 4) Who knows if the multi-byte text format (which is locale- + specific) is even the same for the same locale on + different OS's? It's not even documented anywhere that + I can find what the multi-byte text format for the + Japanese locale under SunOS and Solaris is, but I assume + it's EUC. +*/ -static void x_output_vertical_divider (struct window *w, int clear); -static void x_output_blank (struct window *w, struct display_line *dl, - struct rune *rb, int start_pixpos, - int cursor_start, int cursor_width); -static void x_output_hline (struct window *w, struct display_line *dl, - struct rune *rb); -static void x_output_eol_cursor (struct window *w, struct display_line *dl, - int xpos, face_index findex); -static void x_clear_frame (struct frame *f); -static void x_clear_frame_windows (Lisp_Object window); - - - /* Note: We do not use the Xmb*() functions and XFontSets. - Those functions are generally losing for a number of reasons: - - 1) They only support one locale (e.g. you could display - Japanese and ASCII text, but not mixed Japanese/Chinese - text). You could maybe call setlocale() frequently - to try to deal with this, but that would generally - fail because an XFontSet is tied to one locale and - won't have the other character sets in it. - 2) Not all (or even very many) OS's support the useful - locales. For example, as far as I know SunOS and - Solaris only support the Japanese locale if you get the - special Asian-language version of the OS. Yuck yuck - yuck. Linux doesn't support the Japanese locale at - all. - 3) The locale support in X only exists in R5, not in R4. - (Not sure how big of a problem this is: how many - people are using R4?) - 4) Who knows if the multi-byte text format (which is locale- - specific) is even the same for the same locale on - different OS's? It's not even documented anywhere that - I can find what the multi-byte text format for the - Japanese locale under SunOS and Solaris is, but I assume - it's EUC. - */ - -struct textual_run -{ - Lisp_Object charset; - unsigned char *ptr; - int len; - int dimension; -}; - -/* Separate out the text in DYN into a series of textual runs of a - particular charset. Also convert the characters as necessary into - the format needed by XDrawImageString(), XDrawImageString16(), et - al. (This means converting to one or two byte format, possibly - tweaking the high bits, and possibly running a CCL program.) You - must pre-allocate the space used and pass it in. (This is done so - you can ALLOCA () the space.) You need to allocate (2 * len) bytes - of TEXT_STORAGE and (len * sizeof (struct textual_run)) bytes of - RUN_STORAGE, where LEN is the length of the dynarr. - - Returns the number of runs actually used. */ - -static int -separate_textual_runs (unsigned char *text_storage, - struct textual_run *run_storage, - const Ichar *str, Charcount len) -{ - Lisp_Object prev_charset = Qunbound; /* not Qnil because that is a - possible valid charset when - MULE is not defined */ - int runs_so_far = 0; - int i; -#ifdef MULE - struct ccl_program char_converter; - int need_ccl_conversion = 0; -#endif - - for (i = 0; i < len; i++) - { - Ichar ch = str[i]; - Lisp_Object charset; - int byte1, byte2; - int dimension; - int graphic; - - BREAKUP_ICHAR (ch, charset, byte1, byte2); - dimension = XCHARSET_DIMENSION (charset); - graphic = XCHARSET_GRAPHIC (charset); - - if (!EQ (charset, prev_charset)) - { - run_storage[runs_so_far].ptr = text_storage; - run_storage[runs_so_far].charset = charset; - run_storage[runs_so_far].dimension = dimension; - - if (runs_so_far) - { - run_storage[runs_so_far - 1].len = - text_storage - run_storage[runs_so_far - 1].ptr; - if (run_storage[runs_so_far - 1].dimension == 2) - run_storage[runs_so_far - 1].len >>= 1; - } - runs_so_far++; - prev_charset = charset; -#ifdef MULE - { - Lisp_Object ccl_prog = XCHARSET_CCL_PROGRAM (charset); - if ((!NILP (ccl_prog)) - && (setup_ccl_program (&char_converter, ccl_prog) >= 0)) - need_ccl_conversion = 1; - } -#endif - } - - if (graphic == 0) - { - byte1 &= 0x7F; - byte2 &= 0x7F; - } - else if (graphic == 1) - { - byte1 |= 0x80; - byte2 |= 0x80; - } -#ifdef MULE - if (need_ccl_conversion) - { - char_converter.reg[0] = XCHARSET_ID (charset); - char_converter.reg[1] = byte1; - char_converter.reg[2] = byte2; - ccl_driver (&char_converter, 0, 0, 0, 0, CCL_MODE_ENCODING); - byte1 = char_converter.reg[1]; - byte2 = char_converter.reg[2]; - } -#endif - *text_storage++ = (unsigned char) byte1; - if (dimension == 2) - *text_storage++ = (unsigned char) byte2; - } - - if (runs_so_far) - { - run_storage[runs_so_far - 1].len = - text_storage - run_storage[runs_so_far - 1].ptr; - if (run_storage[runs_so_far - 1].dimension == 2) - run_storage[runs_so_far - 1].len >>= 1; - } - - return runs_so_far; -} - /****************************************************************************/ /* */ /* X output routines */ ＠＠ -233,285 +120,32 ＠＠ } } -/* - x_text_width - - Given a string and a face, return the string's length in pixels when - displayed in the font associated with the face. - */ - -static int -x_text_width (struct frame *UNUSED (f), struct face_cachel *cachel, - const Ichar *str, Charcount len) -{ - /* !!#### Needs review */ - int width_so_far = 0; - unsigned char *text_storage = (unsigned char *) ALLOCA (2 * len); - struct textual_run *runs = alloca_array (struct textual_run, len); - int nruns; - int i; - - nruns = separate_textual_runs (text_storage, runs, str, len); - - for (i = 0; i < nruns; i++) - width_so_far += x_text_width_single_run (cachel, runs + i); - - return width_so_far; -} - -/***************************************************************************** - x_divider_height - - Return the height of the horizontal divider. This is a function because - divider_height is a device method. - - #### If we add etched horizontal divider lines this will have to get - smarter. - ****************************************************************************/ static int x_divider_height (void) { return 1; } -/***************************************************************************** - x_eol_cursor_width - - Return the width of the end-of-line cursor. This is a function - because eol_cursor_width is a device method. - ****************************************************************************/ -static int -x_eol_cursor_width (void) -{ - return EOL_CURSOR_WIDTH; -} - /***************************************************************************** - x_window_output_begin + x_frame_output_begin Perform any necessary initialization prior to an update. ****************************************************************************/ static void -x_window_output_begin (struct window *UNUSED (w)) +x_frame_output_begin (struct frame * UNUSED (f)) { } /***************************************************************************** - x_window_output_end + x_frame_output_end Perform any necessary flushing of queues when an update has completed. ****************************************************************************/ -static void -x_window_output_end (struct window *w) -{ - if (!(check_if_pending_expose_event (WINDOW_XDEVICE (w)))) - XFlush (DEVICE_X_DISPLAY (WINDOW_XDEVICE (w))); -} - -/***************************************************************************** - x_output_display_block - - Given a display line, a block number for that start line, output all - runes between start and end in the specified display block. - ****************************************************************************/ static void -x_output_display_block (struct window *w, struct display_line *dl, int block, - int start, int end, int start_pixpos, int cursor_start, - int cursor_width, int cursor_height) +x_frame_output_end (struct frame *f) { - struct frame *f = XFRAME (w->frame); - Ichar_dynarr *buf = Dynarr_new (Ichar); - Lisp_Object window; - - struct display_block *db = Dynarr_atp (dl->display_blocks, block); - rune_dynarr *rba = db->runes; - struct rune *rb; - - int elt = start; - face_index findex; - int xpos, width = 0; - Lisp_Object charset = Qunbound; /* Qnil is a valid charset when - MULE is not defined */ - - window = wrap_window (w); - rb = Dynarr_atp (rba, start); - - if (!rb) - /* Nothing to do so don't do anything. */ - return; - - findex = rb->findex; - xpos = rb->xpos; - if (rb->type == RUNE_CHAR) - charset = ichar_charset (rb->object.chr.ch); - - if (end < 0) - end = Dynarr_length (rba); - Dynarr_reset (buf); - - while (elt < end) - { - rb = Dynarr_atp (rba, elt); - - if (rb->findex == findex && rb->type == RUNE_CHAR - && rb->object.chr.ch != '\n' && rb->cursor_type != CURSOR_ON - && EQ (charset, ichar_charset (rb->object.chr.ch))) - { - Dynarr_add (buf, rb->object.chr.ch); - width += rb->width; - elt++; - } - else - { - if (Dynarr_length (buf)) - { - x_output_string (w, dl, buf, xpos, 0, start_pixpos, width, - findex, 0, cursor_start, cursor_width, - cursor_height); - xpos = rb->xpos; - width = 0; - } - Dynarr_reset (buf); - width = 0; - - if (rb->type == RUNE_CHAR) - { - findex = rb->findex; - xpos = rb->xpos; - charset = ichar_charset (rb->object.chr.ch); - - if (rb->cursor_type == CURSOR_ON) - { - if (rb->object.chr.ch == '\n') - { - x_output_eol_cursor (w, dl, xpos, findex); - } - else - { - Dynarr_add (buf, rb->object.chr.ch); - x_output_string (w, dl, buf, xpos, 0, start_pixpos, - rb->width, findex, 1, - cursor_start, cursor_width, - cursor_height); - Dynarr_reset (buf); - } - - xpos += rb->width; - elt++; - } - else if (rb->object.chr.ch == '\n') - { - /* Clear in case a cursor was formerly here. */ - redisplay_clear_region (window, findex, xpos, - DISPLAY_LINE_YPOS (dl), - rb->width, - DISPLAY_LINE_HEIGHT (dl)); - elt++; - } - } - else if (rb->type == RUNE_BLANK || rb->type == RUNE_HLINE) - { - if (rb->type == RUNE_BLANK) - x_output_blank (w, dl, rb, start_pixpos, cursor_start, - cursor_width); - else - { - /* #### Our flagging of when we need to redraw the - modeline shadows sucks. Since RUNE_HLINE is only used - by the modeline at the moment it is a good bet - that if it gets redrawn then we should also - redraw the shadows. This won't be true forever. - We borrow the shadow_thickness_changed flag for - now. */ - w->shadow_thickness_changed = 1; - x_output_hline (w, dl, rb); - } - - elt++; - if (elt < end) - { - rb = Dynarr_atp (rba, elt); - - findex = rb->findex; - xpos = rb->xpos; - } - } - else if (rb->type == RUNE_DGLYPH) - { - Lisp_Object instance; - struct display_box dbox; - struct display_glyph_area dga; - - redisplay_calculate_display_boxes (dl, rb->xpos, rb->object.dglyph.xoffset, - rb->object.dglyph.yoffset, start_pixpos, - rb->width, &dbox, &dga); - - window = wrap_window (w); - instance = glyph_image_instance (rb->object.dglyph.glyph, - window, ERROR_ME_DEBUG_WARN, 1); - findex = rb->findex; - - if (IMAGE_INSTANCEP (instance)) - { - switch (XIMAGE_INSTANCE_TYPE (instance)) - { - case IMAGE_MONO_PIXMAP: - case IMAGE_COLOR_PIXMAP: - redisplay_output_pixmap (w, instance, &dbox, &dga, findex, - cursor_start, cursor_width, - cursor_height, 0); - break; - - case IMAGE_WIDGET: - if (EQ (XIMAGE_INSTANCE_WIDGET_TYPE (instance), - Qlayout)) - { - redisplay_output_layout (window, instance, &dbox, &dga, findex, - cursor_start, cursor_width, - cursor_height); - break; - } - case IMAGE_SUBWINDOW: - redisplay_output_subwindow (w, instance, &dbox, &dga, findex, - cursor_start, cursor_width, - cursor_height); - break; - - case IMAGE_NOTHING: - /* nothing is as nothing does */ - break; - - case IMAGE_TEXT: - case IMAGE_POINTER: - default: - ABORT (); - } - IMAGE_INSTANCE_OPTIMIZE_OUTPUT - (XIMAGE_INSTANCE (instance)) = 0; - } - - xpos += rb->width; - elt++; - } - else - ABORT (); - } - } - - if (Dynarr_length (buf)) - x_output_string (w, dl, buf, xpos, 0, start_pixpos, width, findex, - 0, cursor_start, cursor_width, cursor_height); - - /* #### This is really conditionalized well for optimized - performance. */ - if (dl->modeline - && !EQ (Qzero, w->modeline_shadow_thickness) - && (f->clear - || f->windows_structure_changed - || w->shadow_thickness_changed)) - bevel_modeline (w, dl); - - Dynarr_free (buf); + if (!(check_if_pending_expose_event (FRAME_XDEVICE (f)))) + XFlush (DEVICE_X_DISPLAY (FRAME_XDEVICE (f))); } /***************************************************************************** ＠＠ -644,7 +278,7 ＠＠ Given a number of parameters return a GC with those properties. ****************************************************************************/ -static GC +static void * x_get_gc (struct device *d, Lisp_Object font, Lisp_Object fg, Lisp_Object bg, Lisp_Object bg_pmap, Lisp_Object lwidth) { ＠＠ -697,9 +331,22 ＠＠ } /* This special case comes from a request to draw text with a face which has - the dim property. We'll use a stippled foreground GC. */ + the dim property. We'll use a stippled foreground GC. */ if (EQ (bg_pmap, Qdim)) { +#if 0 /* #### No way to get an X window */ + /* Ensure the gray bitmap exists */ + + /* #### 2-13-05 Why did I add the following clause? --ben */ + Display *dpy = DEVICE_X_DISPLAY (d); + Window x_win = XtWindow (FRAME_X_TEXT_WIDGET (f)); + + if (DEVICE_X_GRAY_PIXMAP (d) == None) + DEVICE_X_GRAY_PIXMAP (d) = + XCreateBitmapFromData (dpy, x_win, (char *) gray_bits, + gray_width, gray_height); +#endif + assert (DEVICE_X_GRAY_PIXMAP (d) != None); gcv.fill_style = FillStippled; ＠＠ -731,440 +378,111 ＠＠ return gc_cache_lookup (DEVICE_X_GC_CACHE (d), &gcv, mask); } - -/***************************************************************************** - x_output_string - Given a string and a starting position, output that string in the - given face. If cursor is true, draw a cursor around the string. - Correctly handles multiple charsets in the string. - - The meaning of the parameters is something like this: - - W Window that the text is to be displayed in. - DL Display line that this text is on. The values in the - structure are used to determine the vertical position and - clipping range of the text. - BUF Dynamic array of Ichars specifying what is actually to be - drawn. - XPOS X position in pixels where the text should start being drawn. - XOFFSET Number of pixels to be chopped off the left side of the - text. The effect is as if the text were shifted to the - left this many pixels and clipped at XPOS. - CLIP_START Clip everything left of this X position. - WIDTH Clip everything right of XPOS + WIDTH. - FINDEX Index for the face cache element describing how to display - the text. - CURSOR #### I don't understand this. There's something - strange and overcomplexified with this variable. - Chuck, explain please? - CURSOR_START Starting X position of cursor. - CURSOR_WIDTH Width of cursor in pixels. - CURSOR_HEIGHT Height of cursor in pixels. - - Starting Y position of cursor is the top of the text line. - The cursor is drawn sometimes whether or not CURSOR is set. ??? - ****************************************************************************/ -void -x_output_string (struct window *w, struct display_line *dl, - Ichar_dynarr *buf, int xpos, int xoffset, int clip_start, - int width, face_index findex, int cursor, - int cursor_start, int cursor_width, int cursor_height) +static void +x_set_clip_rectangle (struct frame *f, void *gc, int x, int y, + int width, int height) { - /* General variables */ - struct frame *f = XFRAME (w->frame); - struct device *d = XDEVICE (f->device); - Lisp_Object window; - Display *dpy = DEVICE_X_DISPLAY (d); - Window x_win = XtWindow (FRAME_X_TEXT_WIDGET (f)); - - int clip_end; - - /* Cursor-related variables */ - int focus = EQ (w->frame, DEVICE_FRAME_WITH_FOCUS_REAL (d)); - int cursor_clip; - Lisp_Object bar_cursor_value = symbol_value_in_buffer (Qbar_cursor, - WINDOW_BUFFER (w)); - struct face_cachel *cursor_cachel = 0; - - /* Text-related variables */ - Lisp_Object bg_pmap; - GC bgc, gc; - int height; - int len = Dynarr_length (buf); - unsigned char *text_storage = (unsigned char *) ALLOCA (2 * len); - struct textual_run *runs = alloca_array (struct textual_run, len); - int nruns; - int i; - struct face_cachel *cachel = WINDOW_FACE_CACHEL (w, findex); - - window = wrap_window (w); - - if (width < 0) - width = x_text_width (f, cachel, Dynarr_atp (buf, 0), Dynarr_length (buf)); - height = DISPLAY_LINE_HEIGHT (dl); - - /* Regularize the variables passed in. */ - - if (clip_start < xpos) - clip_start = xpos; - clip_end = xpos + width; - if (clip_start >= clip_end) - /* It's all clipped out. */ - return; - - xpos -= xoffset; - - /* make sure the area we are about to display is subwindow free. */ - redisplay_unmap_subwindows_maybe (f, clip_start, DISPLAY_LINE_YPOS (dl), - clip_end - clip_start, DISPLAY_LINE_HEIGHT (dl)); - - nruns = separate_textual_runs (text_storage, runs, Dynarr_atp (buf, 0), - Dynarr_length (buf)); - - cursor_clip = (cursor_start >= clip_start && - cursor_start < clip_end); - - /* This cursor code is really a mess. */ - if (!NILP (w->text_cursor_visible_p) - && (cursor - || cursor_clip - || (cursor_width - && (cursor_start + cursor_width >= clip_start) - && !NILP (bar_cursor_value)))) - { - /* These have to be in separate statements in order to avoid a - compiler bug. */ - face_index sucks = get_builtin_face_cache_index (w, Vtext_cursor_face); - cursor_cachel = WINDOW_FACE_CACHEL (w, sucks); - - /* We have to reset this since any call to WINDOW_FACE_CACHEL - may cause the cache to resize and any pointers to it to - become invalid. */ - cachel = WINDOW_FACE_CACHEL (w, findex); - } - -#ifdef HAVE_XIM - if (cursor && focus && (cursor_start == clip_start) && cursor_height) - XIM_SetSpotLocation (f, xpos - 2, dl->ypos + dl->descent - 2); -#endif /* HAVE_XIM */ - - bg_pmap = cachel->background_pixmap; - if (!IMAGE_INSTANCEP (bg_pmap) - || !IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (bg_pmap))) - bg_pmap = Qnil; - - if ((cursor && focus && NILP (bar_cursor_value) - && !NILP (w->text_cursor_visible_p)) || NILP (bg_pmap)) - bgc = 0; - else - bgc = x_get_gc (d, Qnil, cachel->foreground, cachel->background, - bg_pmap, Qnil); - - if (bgc) - XFillRectangle (dpy, x_win, bgc, clip_start, - DISPLAY_LINE_YPOS (dl), clip_end - clip_start, - height); - - for (i = 0; i < nruns; i++) - { - Lisp_Object font = FACE_CACHEL_FONT (cachel, runs[i].charset); - Lisp_Font_Instance *fi = XFONT_INSTANCE (font); - int this_width; - int need_clipping; - - if (EQ (font, Vthe_null_font_instance)) - continue; - - this_width = x_text_width_single_run (cachel, runs + i); - need_clipping = (dl->clip || clip_start > xpos || - clip_end < xpos + this_width); - - /* XDrawImageString only clears the area equal to the height of - the given font. It is possible that a font is being displayed - on a line taller than it is, so this would cause us to fail to - clear some areas. */ - if ((int) fi->height < (int) (height + dl->clip + dl->top_clip)) - { - int clear_start = max (xpos, clip_start); - int clear_end = min (xpos + this_width, clip_end); - - if (cursor) - { - int ypos1_line, ypos1_string, ypos2_line, ypos2_string; - - ypos1_string = dl->ypos - fi->ascent; - ypos2_string = dl->ypos + fi->descent; - ypos1_line = DISPLAY_LINE_YPOS (dl); - ypos2_line = ypos1_line + DISPLAY_LINE_HEIGHT (dl); - - /* Make sure we don't clear below the real bottom of the - line. */ - if (ypos1_string > ypos2_line) - ypos1_string = ypos2_line; - if (ypos2_string > ypos2_line) - ypos2_string = ypos2_line; - - if (ypos1_line < ypos1_string) - { - redisplay_clear_region (window, findex, clear_start, ypos1_line, - clear_end - clear_start, - ypos1_string - ypos1_line); - } - - if (ypos2_line > ypos2_string) - { - redisplay_clear_region (window, findex, clear_start, ypos2_string, - clear_end - clear_start, - ypos2_line - ypos2_string); - } - } - else - { - redisplay_clear_region (window, findex, clear_start, - DISPLAY_LINE_YPOS (dl), clear_end - clear_start, - height); - } - } - - if (cursor && cursor_cachel && focus && NILP (bar_cursor_value)) - gc = x_get_gc (d, font, cursor_cachel->foreground, - cursor_cachel->background, Qnil, Qnil); - else if (cachel->dim) - { - /* Ensure the gray bitmap exists */ - if (DEVICE_X_GRAY_PIXMAP (d) == None) - DEVICE_X_GRAY_PIXMAP (d) = - XCreateBitmapFromData (dpy, x_win, (char *)gray_bits, - gray_width, gray_height); - - /* Request a GC with the gray stipple pixmap to draw dimmed text */ - gc = x_get_gc (d, font, cachel->foreground, cachel->background, - Qdim, Qnil); - } - else - gc = x_get_gc (d, font, cachel->foreground, cachel->background, - Qnil, Qnil); - - if (need_clipping) - { - XRectangle clip_box[1]; + Display *dpy = DEVICE_X_DISPLAY (FRAME_XDEVICE (f)); + XRectangle clip_box[1]; - clip_box[0].x = 0; - clip_box[0].y = 0; - clip_box[0].width = clip_end - clip_start; - clip_box[0].height = height; - - XSetClipRectangles (dpy, gc, clip_start, DISPLAY_LINE_YPOS (dl), - clip_box, 1, Unsorted); - } - - if (runs[i].dimension == 1) - (bgc ? XDrawString : XDrawImageString) (dpy, x_win, gc, xpos, - dl->ypos, (char *) runs[i].ptr, - runs[i].len); - else - (bgc ? XDrawString16 : XDrawImageString16) (dpy, x_win, gc, xpos, - dl->ypos, - (XChar2b *) runs[i].ptr, - runs[i].len); - - /* We draw underlines in the same color as the text. */ - if (cachel->underline) - { - int upos, uthick; - unsigned long upos_ext, uthick_ext; - XFontStruct *xfont; - - xfont = FONT_INSTANCE_X_FONT (XFONT_INSTANCE (font)); - if (!XGetFontProperty (xfont, XA_UNDERLINE_POSITION, &upos_ext)) - upos = dl->descent / 2; - else - upos = (int) upos_ext; - if (!XGetFontProperty (xfont, XA_UNDERLINE_THICKNESS, &uthick_ext)) - uthick = 1; - else - uthick = (int) uthick_ext; - - if (dl->ypos + upos < dl->ypos + dl->descent - dl->clip) - { - if (dl->ypos + upos + uthick > dl->ypos + dl->descent - dl->clip) - uthick = dl->descent - dl->clip - upos; - - if (uthick == 1) - { - XDrawLine (dpy, x_win, gc, xpos, dl->ypos + upos, - xpos + this_width, dl->ypos + upos); - } - else if (uthick > 1) - { - XFillRectangle (dpy, x_win, gc, xpos, - dl->ypos + upos, this_width, uthick); - } - } - } - - if (cachel->strikethru) - { - int ascent, descent, upos, uthick; - unsigned long ascent_ext, descent_ext, uthick_ext; - XFontStruct *xfont; - - xfont = FONT_INSTANCE_X_FONT (XFONT_INSTANCE (font)); - - if (!XGetFontProperty (xfont, XA_STRIKEOUT_ASCENT, &ascent_ext)) - ascent = xfont->ascent; - else - ascent = (int) ascent_ext; - if (!XGetFontProperty (xfont, XA_STRIKEOUT_DESCENT, &descent_ext)) - descent = xfont->descent; - else - descent = (int) descent_ext; - if (!XGetFontProperty (xfont, XA_UNDERLINE_THICKNESS, &uthick_ext)) - uthick = 1; - else - uthick = (int) uthick_ext; - - upos = ascent - ((ascent + descent) / 2) + 1; - - /* Generally, upos will be positive (above the baseline),so - subtract */ - if (dl->ypos - upos < dl->ypos + dl->descent - dl->clip) - { - if (dl->ypos - upos + uthick > dl->ypos + dl->descent - dl->clip) - uthick = dl->descent - dl->clip + upos; - - if (uthick == 1) - XDrawLine (dpy, x_win, gc, xpos, dl->ypos - upos, - xpos + this_width, dl->ypos - upos); - else if (uthick > 1) - XFillRectangle (dpy, x_win, gc, xpos, dl->ypos + upos, - this_width, uthick); - } - } - - /* Restore the GC */ - if (need_clipping) - { - XSetClipMask (dpy, gc, None); - XSetClipOrigin (dpy, gc, 0, 0); - } + clip_box[0].x = 0; + clip_box[0].y = 0; + clip_box[0].width = width; + clip_box[0].height = height; + XSetClipRectangles (dpy, (GC) gc, x, y, clip_box, 1, Unsorted); +} - /* If we are actually superimposing the cursor then redraw with just - the appropriate section highlighted. */ - if (cursor_clip && !cursor && focus && cursor_cachel) - { - GC cgc; - XRectangle clip_box[1]; +static void +x_unset_clip_rectangle (struct frame *f, void *gc) +{ + Display *dpy = DEVICE_X_DISPLAY (FRAME_XDEVICE (f)); + XSetClipMask (dpy, (GC) gc, None); + XSetClipOrigin (dpy, (GC) gc, 0, 0); +} - cgc = x_get_gc (d, font, cursor_cachel->foreground, - cursor_cachel->background, Qnil, Qnil); +static void +x_draw_rectangle (struct frame *f, void *gc, int filled, int x, int y, + int width, int height) +{ + Display *dpy = DEVICE_X_DISPLAY (FRAME_XDEVICE (f)); + Window x_win = XtWindow (FRAME_X_TEXT_WIDGET (f)); + (filled ? XFillRectangle : XDrawRectangle) + (dpy, x_win, (GC) gc, x, y, width, height); +} - clip_box[0].x = 0; - clip_box[0].y = 0; - clip_box[0].width = cursor_width; - clip_box[0].height = height; - - XSetClipRectangles (dpy, cgc, cursor_start, DISPLAY_LINE_YPOS (dl), - clip_box, 1, Unsorted); - - if (runs[i].dimension == 1) - XDrawImageString (dpy, x_win, cgc, xpos, dl->ypos, - (char *) runs[i].ptr, runs[i].len); - else - XDrawImageString16 (dpy, x_win, cgc, xpos, dl->ypos, - (XChar2b *) runs[i].ptr, runs[i].len); +static void +x_draw_line (struct frame *f, void *gc, int x1, int y1, int x2, int y2) +{ + Display *dpy = DEVICE_X_DISPLAY (FRAME_XDEVICE (f)); + Window x_win = XtWindow (FRAME_X_TEXT_WIDGET (f)); + XDrawLine (dpy, x_win, (GC) gc, x1, y1, x2, y2); +} - XSetClipMask (dpy, cgc, None); - XSetClipOrigin (dpy, cgc, 0, 0); - } +static int +x_get_font_property (Lisp_Object font, enum xlike_font_property prop, + int *value) +{ + XFontStruct *xfont; + unsigned long retval; + Atom xprop; - xpos += this_width; + xfont = FONT_INSTANCE_X_FONT (XFONT_INSTANCE (font)); + switch (prop) + { + case XLIKE_UNDERLINE_POSITION: xprop = XLIKE_UNDERLINE_POSITION; break; + case XLIKE_UNDERLINE_THICKNESS: xprop = XLIKE_UNDERLINE_THICKNESS; break; + case XLIKE_STRIKEOUT_ASCENT: xprop = XLIKE_STRIKEOUT_ASCENT; break; + case XLIKE_STRIKEOUT_DESCENT: xprop = XLIKE_STRIKEOUT_DESCENT; break; + default: ABORT (); xprop = 0; break; } - - /* Draw the non-focus box or bar-cursor as needed. */ - /* Can't this logic be simplified? */ - if (cursor_cachel - && ((cursor && !focus && NILP (bar_cursor_value)) - || (cursor_width - && (cursor_start + cursor_width >= clip_start) - && !NILP (bar_cursor_value)))) - { - int tmp_height, tmp_y; - int bar_width = EQ (bar_cursor_value, Qt) ? 1 : 2; - int need_clipping = (cursor_start < clip_start - || clip_end < cursor_start + cursor_width); - - /* #### This value is correct (as far as I know) because - all of the times we need to draw this cursor, we will - be called with exactly one character, so we know we - can always use runs[0]. - - This is bogus as all hell, however. The cursor handling in - this function is way bogus and desperately needs to be - cleaned up. (In particular, the drawing of the cursor should - really really be separated out of this function. This may be - a bit tricky now because this function itself does way too - much stuff, a lot of which needs to be moved into - redisplay.c) This is the only way to be able to easily add - new cursor types or (e.g.) make the bar cursor be able to - span two characters instead of overlaying just one. */ - int bogusly_obtained_ascent_value = - XFONT_INSTANCE (FACE_CACHEL_FONT (cachel, runs[0].charset))->ascent; - if (!NILP (bar_cursor_value)) - { - gc = x_get_gc (d, Qnil, cursor_cachel->background, Qnil, Qnil, - make_int (bar_width)); - } + if (!XGetFontProperty (xfont, prop, &retval)) + { + if (prop == XLIKE_STRIKEOUT_ASCENT) + retval = xfont->ascent; + else if (prop == XLIKE_STRIKEOUT_DESCENT) + retval = xfont->descent; else - { - gc = x_get_gc (d, Qnil, cursor_cachel->background, - Qnil, Qnil, Qnil); - } + return 0; + } - tmp_y = dl->ypos - bogusly_obtained_ascent_value; - tmp_height = cursor_height; - if (tmp_y + tmp_height > (int) (DISPLAY_LINE_YPOS(dl) + height)) - { - tmp_y = DISPLAY_LINE_YPOS (dl) + height - tmp_height; - if (tmp_y < (int) DISPLAY_LINE_YPOS (dl)) - tmp_y = DISPLAY_LINE_YPOS (dl); - tmp_height = DISPLAY_LINE_YPOS (dl) + height - tmp_y; - } + *value = (int) retval; + return 1; +} - if (need_clipping) - { - XRectangle clip_box[1]; - clip_box[0].x = 0; - clip_box[0].y = 0; - clip_box[0].width = clip_end - clip_start; - clip_box[0].height = tmp_height; - XSetClipRectangles (dpy, gc, clip_start, tmp_y, - clip_box, 1, Unsorted); - } +static void +x_draw_text (struct frame *f, Lisp_Object font, void *gc, int bgc_present, + int x, int y, unsigned char *ptr, int len, int dimension) +{ + Display *dpy = DEVICE_X_DISPLAY (FRAME_XDEVICE (f)); + Window x_win = XtWindow (FRAME_X_TEXT_WIDGET (f)); + if (dimension == 1) + (bgc_present ? XDrawString : XDrawImageString) (dpy, x_win, (GC) gc, x, + y, (char *) ptr, len); + else + (bgc_present ? XDrawString16 : XDrawImageString16) (dpy, x_win, (GC) gc, + x, y, (XChar2b *) ptr, + len); +} - if (!focus && NILP (bar_cursor_value)) - { - XDrawRectangle (dpy, x_win, gc, cursor_start, tmp_y, - cursor_width - 1, tmp_height - 1); - } - else if (focus && !NILP (bar_cursor_value)) - { - XDrawLine (dpy, x_win, gc, cursor_start + bar_width - 1, tmp_y, - cursor_start + bar_width - 1, tmp_y + tmp_height - 1); - } +static void +x_clear_area (struct frame *f, int x, int y, int width, int height) +{ + Display *dpy = DEVICE_X_DISPLAY (FRAME_XDEVICE (f)); + Window x_win = XtWindow (FRAME_X_TEXT_WIDGET (f)); + XClearArea (dpy, x_win, x, y, width, height, False); +} - /* Restore the GC */ - if (need_clipping) - { - XSetClipMask (dpy, gc, None); - XSetClipOrigin (dpy, gc, 0, 0); - } - } +static void +x_set_spot_location (struct frame *f, int x, int y) +{ +#ifdef HAVE_XIM + XIM_SetSpotLocation (f, x, y); +#endif /* HAVE_XIM */ } -void +static void x_output_x_pixmap (struct frame *f, Lisp_Image_Instance *p, int x, int y, int xoffset, int yoffset, int width, int height, unsigned long fg, unsigned long bg, ＠＠ -1235,16 +553,11 ＠＠ static void x_output_pixmap (struct window *w, Lisp_Object image_instance, struct display_box *db, struct display_glyph_area *dga, - face_index findex, int cursor_start, int cursor_width, - int cursor_height, int UNUSED (bg_pixmap)) + face_index findex, int bg_pixmap) { struct frame *f = XFRAME (w->frame); - struct device *d = XDEVICE (f->device); Lisp_Image_Instance *p = XIMAGE_INSTANCE (image_instance); - Display *dpy = DEVICE_X_DISPLAY (d); - Window x_win = XtWindow (FRAME_X_TEXT_WIDGET (f)); - /* Output the pixmap. */ { Lisp_Object tmp_pixel; ＠＠ -1260,35 +573,6 ＠＠ dga->width, dga->height, tmp_fcolor.pixel, tmp_bcolor.pixel, 0); } - - /* Draw a cursor over top of the pixmap. */ - if (cursor_width && cursor_height && (cursor_start >= db->xpos) - && !NILP (w->text_cursor_visible_p) - && (cursor_start < db->xpos + dga->width)) - { - GC gc; - int focus = EQ (w->frame, DEVICE_FRAME_WITH_FOCUS_REAL (d)); - struct face_cachel *cursor_cachel = - WINDOW_FACE_CACHEL (w, - get_builtin_face_cache_index - (w, Vtext_cursor_face)); - - gc = x_get_gc (d, Qnil, cursor_cachel->background, Qnil, Qnil, Qnil); - - if (cursor_width > db->xpos + dga->width - cursor_start) - cursor_width = db->xpos + dga->width - cursor_start; - - if (focus) - { - XFillRectangle (dpy, x_win, gc, cursor_start, db->ypos, cursor_width, - cursor_height); - } - else - { - XDrawRectangle (dpy, x_win, gc, cursor_start, db->ypos, cursor_width, - cursor_height); - } - } } /***************************************************************************** ＠＠ -1362,170 +646,12 ＠＠ } /***************************************************************************** - x_output_blank - - Output a blank by clearing the area it covers in the foreground color - of its face. - ****************************************************************************/ -static void -x_output_blank (struct window *w, struct display_line *dl, struct rune *rb, - int start_pixpos, int cursor_start, int cursor_width) -{ - struct frame *f = XFRAME (w->frame); - struct device *d = XDEVICE (f->device); - - Display *dpy = DEVICE_X_DISPLAY (d); - Window x_win = XtWindow (FRAME_X_TEXT_WIDGET (f)); - GC gc; - struct face_cachel *cursor_cachel = - WINDOW_FACE_CACHEL (w, - get_builtin_face_cache_index - (w, Vtext_cursor_face)); - Lisp_Object bg_pmap; - Lisp_Object buffer = WINDOW_BUFFER (w); - Lisp_Object bar_cursor_value = symbol_value_in_buffer (Qbar_cursor, - buffer); - - int x = rb->xpos; - int y = DISPLAY_LINE_YPOS (dl); - int width = rb->width; - int height = DISPLAY_LINE_HEIGHT (dl); - - /* Unmap all subwindows in the area we are going to blank. */ - redisplay_unmap_subwindows_maybe (f, x, y, width, height); - - if (start_pixpos > x) - { - if (start_pixpos >= (x + width)) - return; - else - { - width -= (start_pixpos - x); - x = start_pixpos; - } - } - - bg_pmap = WINDOW_FACE_CACHEL_BACKGROUND_PIXMAP (w, rb->findex); - if (!IMAGE_INSTANCEP (bg_pmap) - || !IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (bg_pmap))) - bg_pmap = Qnil; - - if (NILP (bg_pmap)) - gc = x_get_gc (d, Qnil, WINDOW_FACE_CACHEL_BACKGROUND (w, rb->findex), - Qnil, Qnil, Qnil); - else - gc = x_get_gc (d, Qnil, WINDOW_FACE_CACHEL_FOREGROUND (w, rb->findex), - WINDOW_FACE_CACHEL_BACKGROUND (w, rb->findex), bg_pmap, - Qnil); - - XFillRectangle (dpy, x_win, gc, x, y, width, height); - - /* If this rune is marked as having the cursor, then it is actually - representing a tab. */ - if (!NILP (w->text_cursor_visible_p) - && (rb->cursor_type == CURSOR_ON - || (cursor_width - && (cursor_start + cursor_width > x) - && cursor_start < (x + width)))) - { - int cursor_height, cursor_y; - int focus = EQ (w->frame, DEVICE_FRAME_WITH_FOCUS_REAL (d)); - Lisp_Font_Instance *fi; - - fi = XFONT_INSTANCE (FACE_CACHEL_FONT - (WINDOW_FACE_CACHEL (w, rb->findex), - Vcharset_ascii)); - - gc = x_get_gc (d, Qnil, cursor_cachel->background, Qnil, Qnil, Qnil); - - cursor_y = dl->ypos - fi->ascent; - cursor_height = fi->height; - if (cursor_y + cursor_height > y + height) - cursor_height = y + height - cursor_y; - - if (focus) - { - if (NILP (bar_cursor_value)) - { - XFillRectangle (dpy, x_win, gc, cursor_start, cursor_y, - fi->width, cursor_height); - } - else - { - int bar_width = EQ (bar_cursor_value, Qt) ? 1 : 2; - - gc = x_get_gc (d, Qnil, cursor_cachel->background, Qnil, Qnil, - make_int (bar_width)); - XDrawLine (dpy, x_win, gc, cursor_start + bar_width - 1, - cursor_y, cursor_start + bar_width - 1, - cursor_y + cursor_height - 1); - } - } - else if (NILP (bar_cursor_value)) - { - XDrawRectangle (dpy, x_win, gc, cursor_start, cursor_y, - fi->width - 1, cursor_height - 1); - } - } -} - -/***************************************************************************** - x_output_hline - - Output a horizontal line in the foreground of its face. - ****************************************************************************/ -static void -x_output_hline (struct window *w, struct display_line *dl, struct rune *rb) -{ - struct frame *f = XFRAME (w->frame); - struct device *d = XDEVICE (f->device); - - Display *dpy = DEVICE_X_DISPLAY (d); - Window x_win = XtWindow (FRAME_X_TEXT_WIDGET (f)); - GC gc; - - int x = rb->xpos; - int width = rb->width; - int height = DISPLAY_LINE_HEIGHT (dl); - int ypos1, ypos2, ypos3, ypos4; - - ypos1 = DISPLAY_LINE_YPOS (dl); - ypos2 = ypos1 + rb->object.hline.yoffset; - ypos3 = ypos2 + rb->object.hline.thickness; - ypos4 = dl->ypos + dl->descent - dl->clip; - - /* First clear the area not covered by the line. */ - if (height - rb->object.hline.thickness > 0) - { - gc = x_get_gc (d, Qnil, WINDOW_FACE_CACHEL_FOREGROUND (w, rb->findex), - Qnil, Qnil, Qnil); - - if (ypos2 - ypos1 > 0) - XFillRectangle (dpy, x_win, gc, x, ypos1, width, ypos2 - ypos1); - if (ypos4 - ypos3 > 0) - XFillRectangle (dpy, x_win, gc, x, ypos1, width, ypos2 - ypos1); - } - - /* Now draw the line. */ - gc = x_get_gc (d, Qnil, WINDOW_FACE_CACHEL_BACKGROUND (w, rb->findex), - Qnil, Qnil, Qnil); - - if (ypos2 < ypos1) - ypos2 = ypos1; - if (ypos3 > ypos4) - ypos3 = ypos4; - - if (ypos3 - ypos2 > 0) - XFillRectangle (dpy, x_win, gc, x, ypos2, width, ypos3 - ypos2); -} - -/***************************************************************************** x_output_shadows Draw a shadow around the given area using the given GC's. It is the callers responsibility to set the GC's appropriately. ****************************************************************************/ -void +static void x_output_shadows (struct frame *f, int x, int y, int width, int height, GC top_shadow_gc, GC bottom_shadow_gc, GC UNUSED (background_gc), int shadow_thickness, int edges) ＠＠ -1601,7 +727,7 ＠＠ #define MINL(x,y) ((((unsigned long) (x)) < ((unsigned long) (y))) \ ? ((unsigned long) (x)) : ((unsigned long) (y))) -void +static void x_generate_shadow_pixels (struct frame *f, unsigned long *top_shadow, unsigned long *bottom_shadow, unsigned long background, ＠＠ -1671,176 +797,6 ＠＠ } } -/**************************************************************************** - x_clear_region - - Clear the area in the box defined by the given parameters using the - given face. - ****************************************************************************/ -static void -x_clear_region (Lisp_Object UNUSED (locale), struct device* d, - struct frame* f, face_index UNUSED (findex), - int x, int y, - int width, int height, Lisp_Object fcolor, Lisp_Object bcolor, - Lisp_Object background_pixmap) -{ - Display *dpy; - Window x_win; - GC gc = NULL; - - dpy = DEVICE_X_DISPLAY (d); - x_win = XtWindow (FRAME_X_TEXT_WIDGET (f)); - - if (!UNBOUNDP (background_pixmap)) - { - gc = x_get_gc (d, Qnil, fcolor, bcolor, background_pixmap, Qnil); - } - - if (gc) - XFillRectangle (dpy, x_win, gc, x, y, width, height); - else - XClearArea (dpy, x_win, x, y, width, height, False); -} - -/***************************************************************************** - x_output_eol_cursor - - Draw a cursor at the end of a line. The end-of-line cursor is - narrower than the normal cursor. - ****************************************************************************/ -static void -x_output_eol_cursor (struct window *w, struct display_line *dl, int xpos, - face_index findex) -{ - struct frame *f = XFRAME (w->frame); - struct device *d = XDEVICE (f->device); - Lisp_Object window; - - Display *dpy = DEVICE_X_DISPLAY (d); - Window x_win = XtWindow (FRAME_X_TEXT_WIDGET (f)); - GC gc; - face_index elt = get_builtin_face_cache_index (w, Vtext_cursor_face); - struct face_cachel *cursor_cachel = WINDOW_FACE_CACHEL (w, elt); - - int focus = EQ (w->frame, DEVICE_FRAME_WITH_FOCUS_REAL (d)); - Lisp_Object bar_cursor_value = symbol_value_in_buffer (Qbar_cursor, - WINDOW_BUFFER (w)); - - int x = xpos; - int y = DISPLAY_LINE_YPOS (dl); - int width = EOL_CURSOR_WIDTH; - int height = DISPLAY_LINE_HEIGHT (dl); - int cursor_height, cursor_y; - int defheight, defascent; - - window = wrap_window (w); - redisplay_clear_region (window, findex, x, y, width, height); - - if (NILP (w->text_cursor_visible_p)) - return; - - gc = x_get_gc (d, Qnil, cursor_cachel->background, Qnil, Qnil, Qnil); - - default_face_font_info (window, &defascent, 0, &defheight, 0, 0); - - /* make sure the cursor is entirely contained between y and y+height */ - cursor_height = min (defheight, height); - cursor_y = max (y, min (y + height - cursor_height, - dl->ypos - defascent)); - - if (focus) - { -#ifdef HAVE_XIM - XIM_SetSpotLocation (f, x - 2 , cursor_y + cursor_height - 2); -#endif /* HAVE_XIM */ - - if (NILP (bar_cursor_value)) - { - XFillRectangle (dpy, x_win, gc, x, cursor_y, width, cursor_height); - } - else - { - int bar_width = EQ (bar_cursor_value, Qt) ? 1 : 2; - - gc = x_get_gc (d, Qnil, cursor_cachel->background, Qnil, Qnil, - make_int (bar_width)); - XDrawLine (dpy, x_win, gc, x + bar_width - 1, cursor_y, - x + bar_width - 1, cursor_y + cursor_height - 1); - } - } - else if (NILP (bar_cursor_value)) - { - XDrawRectangle (dpy, x_win, gc, x, cursor_y, width - 1, - cursor_height - 1); - } -} - -static void -x_clear_frame_window (Lisp_Object window) -{ - struct window *w = XWINDOW (window); - - if (!NILP (w->vchild)) - { - x_clear_frame_windows (w->vchild); - return; - } - - if (!NILP (w->hchild)) - { - x_clear_frame_windows (w->hchild); - return; - } - - redisplay_clear_to_window_end (w, WINDOW_TEXT_TOP (w), - WINDOW_TEXT_BOTTOM (w)); -} - -static void -x_clear_frame_windows (Lisp_Object window) -{ - for (; !NILP (window); window = XWINDOW (window)->next) - x_clear_frame_window (window); -} - -static void -x_clear_frame (struct frame *f) -{ - struct device *d = XDEVICE (f->device); - Display *dpy = DEVICE_X_DISPLAY (d); - Window x_win = XtWindow (FRAME_X_TEXT_WIDGET (f)); - int x, y, width, height; - Lisp_Object frame; - - x = FRAME_LEFT_BORDER_START (f); - width = (FRAME_PIXWIDTH (f) - FRAME_REAL_LEFT_TOOLBAR_WIDTH (f) - - FRAME_REAL_RIGHT_TOOLBAR_WIDTH (f) - - 2 * FRAME_REAL_LEFT_TOOLBAR_BORDER_WIDTH (f) - - 2 * FRAME_REAL_RIGHT_TOOLBAR_BORDER_WIDTH (f)); - /* #### This adjustment by 1 should be being done in the macros. - There is some small differences between when the menubar is on - and off that we still need to deal with. */ - y = FRAME_TOP_BORDER_START (f) - 1; - height = (FRAME_PIXHEIGHT (f) - FRAME_REAL_TOP_TOOLBAR_HEIGHT (f) - - FRAME_REAL_BOTTOM_TOOLBAR_HEIGHT (f) - - 2 * FRAME_REAL_TOP_TOOLBAR_BORDER_WIDTH (f) - - 2 * FRAME_REAL_BOTTOM_TOOLBAR_BORDER_WIDTH (f)) + 1; - - XClearArea (dpy, x_win, x, y, width, height, False); - - frame = wrap_frame (f); - - if (!UNBOUNDP (FACE_BACKGROUND_PIXMAP (Vdefault_face, frame)) - || !UNBOUNDP (FACE_BACKGROUND_PIXMAP (Vleft_margin_face, frame)) - || !UNBOUNDP (FACE_BACKGROUND_PIXMAP (Vright_margin_face, frame))) - { - x_clear_frame_windows (f->root_window); - } - - if (!(check_if_pending_expose_event (d))) - XFlush (DEVICE_X_DISPLAY (d)); -} - /* briefly swap the foreground and background colors. */ ＠＠ -1973,18 +929,33 ＠＠ console_type_create_redisplay_x (void) { /* redisplay methods */ - CONSOLE_HAS_METHOD (x, text_width); - CONSOLE_HAS_METHOD (x, output_display_block); + CONSOLE_INHERITS_METHOD (x, xlike, text_width); + CONSOLE_INHERITS_METHOD (x, xlike, output_string); + CONSOLE_INHERITS_METHOD (x, xlike, output_hline); + CONSOLE_INHERITS_METHOD (x, xlike, output_blank); + CONSOLE_INHERITS_METHOD (x, xlike, output_cursor); + CONSOLE_INHERITS_METHOD (x, xlike, eol_cursor_width); + CONSOLE_INHERITS_METHOD (x, xlike, clear_region); + CONSOLE_INHERITS_METHOD (x, xlike, clear_frame); + CONSOLE_HAS_METHOD (x, divider_height); - CONSOLE_HAS_METHOD (x, eol_cursor_width); CONSOLE_HAS_METHOD (x, output_vertical_divider); - CONSOLE_HAS_METHOD (x, clear_region); - CONSOLE_HAS_METHOD (x, clear_frame); - CONSOLE_HAS_METHOD (x, window_output_begin); - CONSOLE_HAS_METHOD (x, window_output_end); + CONSOLE_HAS_METHOD (x, frame_output_begin); + CONSOLE_HAS_METHOD (x, frame_output_end); CONSOLE_HAS_METHOD (x, flash); CONSOLE_HAS_METHOD (x, ring_bell); CONSOLE_HAS_METHOD (x, bevel_area); - CONSOLE_HAS_METHOD (x, output_string); CONSOLE_HAS_METHOD (x, output_pixmap); + + /* xlike methods */ + CONSOLE_HAS_METHOD (x, text_width_single_run); + CONSOLE_HAS_METHOD (x, get_gc); + CONSOLE_HAS_METHOD (x, set_clip_rectangle); + CONSOLE_HAS_METHOD (x, unset_clip_rectangle); + CONSOLE_HAS_METHOD (x, draw_rectangle); + CONSOLE_HAS_METHOD (x, draw_line); + CONSOLE_HAS_METHOD (x, clear_area); + CONSOLE_HAS_METHOD (x, get_font_property); + CONSOLE_HAS_METHOD (x, draw_text); + CONSOLE_HAS_METHOD (x, set_spot_location); } 1.96.4.1 +869 -1453 XEmacs/xemacs/src/redisplay.c Index: redisplay.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/redisplay.c,v retrieving revision 1.96 retrieving revision 1.96.4.1 diff -u -r1.96 -r1.96.4.1 --- redisplay.c 2005/02/03 16:30:38 1.96 +++ redisplay.c 2005/02/16 00:43:48 1.96.4.1 ＠＠ -1,7 +1,7 ＠＠ /* Display generation from window structure and buffer text. Copyright (C) 1994, 1995, 1996 Board of Trustees, University of Illinois. Copyright (C) 1995 Free Software Foundation, Inc. - Copyright (C) 1995, 1996, 2000, 2001, 2002, 2003 Ben Wing. + Copyright (C) 1995, 1996, 2000, 2001, 2002, 2003, 2005 Ben Wing. Copyright (C) 1995 Sun Microsystems, Inc. Copyright (C) 1996 Chuck Thompson. ＠＠ -159,11 +159,29 ＠＠ scrolling, where a certain number of columns (those off the left side of the screen) need to be skipped before anything is displayed. */ - Bytexpos byte_start_col_enabled; - int start_col_xoffset; /* Number of pixels that still need to - be skipped. This is used for - horizontal scrolling of glyphs, where we want - to be able to scroll over part of the glyph. */ + Bytexpos byte_start_col_enabled; /* If non-zero, records the position of + the beginning of the logical display + line and indicates that an hscroll + glyph needs to be added. It seems + that, when adding a rune, we eat up a + START_COL instead of adding the rune + if there is a START_COL; and we've + eaten the last one, if + BYTE_START_COL_ENABLED is non-zero, + we then add the hscroll glyph. (#### + Are there any times when START_COL is + non-zero and BYTE_START_COL_ENABLED + is zero? I don't see any places + where this is true except maybe for + some weirdness involving text image + instances.) #### The logic to check + START_COL is duplicated in many + places, which is not good. */ + int start_col_xoffset; /* Number of pixels that still need to be + skipped. This is used for horizontal + scrolling of glyphs, where we want to be + able to scroll over part of the + glyph. */ int hscroll_glyph_width_adjust; /* how much the width of the hscroll glyph differs from space_width (w). ＠＠ -277,22 +295,23 ＠＠ int depth, int max_pixsize, face_index findex, int type, Charcount *offset, - Lisp_Object cur_ext); + Lisp_Object cur_ext, + Lisp_Object matchspec); static prop_block_dynarr *add_glyph_rune (pos_data *data, struct glyph_block *gb, int pos_type, int allow_cursor, struct glyph_cachel *cachel); -static Bytebpos create_text_block (struct window *w, struct display_line *dl, - Bytebpos byte_start_pos, +static Charxpos create_text_block (struct window *w, struct display_line *dl, + Charxpos start_pos, prop_block_dynarr **prop, + Lisp_Object disp_string, + face_index default_face, int type); static int create_overlay_glyph_block (struct window *w, struct display_line *dl); -static void create_left_glyph_block (struct window *w, - struct display_line *dl, - int overlay_width); -static void create_right_glyph_block (struct window *w, - struct display_line *dl); +static void create_left_or_right_glyph_block (struct window *w, + struct display_line *dl, + int overlay_width, int side); static void redisplay_windows (Lisp_Object window, int skip_selected); static void decode_mode_spec (struct window *w, Ichar spec, int type); static void free_display_line (struct display_line *dl); ＠＠ -403,14 +422,14 ＠＠ int glyphs_changed; int glyphs_changed_set; -/* non-zero if any subwindow has been deleted. */ -int subwindows_changed; -int subwindows_changed_set; +/* non-zero if any subcontrol has been deleted. */ +int subcontrols_changed; +int subcontrols_changed_set; -/* non-zero if any displayed subwindow is in need of updating +/* non-zero if any displayed subcontrol is in need of updating somewhere. */ -int subwindows_state_changed; -int subwindows_state_changed_set; +int subcontrols_state_changed; +int subcontrols_state_changed_set; /* This variable is 1 if the icon has to be updated. It is set to 1 when `frame-icon-glyph' changes. */ ＠＠ -934,21 +953,28 ＠＠ } } -/* Given a display line and a starting position, ensure that the - contents of the display line accurately represent the visual - representation of the buffer contents starting from the given - position when displayed in the given window. The display line ends - when the contents of the line reach the right boundary of the given - window. */ +/* Given a display line and a starting position, ensure that the contents + of the display line accurately represent the visual representation of + the buffer contents (or string contents, if DISP_STRING is non-nil) + starting from the given position when displayed in the given window. + The display line ends when the contents of the line reach the right + boundary of the given window. + + DISP_STRING and DEFAULT_FACE are used for string processing; + TYPE is for buffer processing. (TYPE is CURRENT_DISP, DESIRED_DISP, or + CMOTION_DISP, used only to retrieve the current point value for cursor + processing -- not used for strings. DEFAULT_FACE should always be + DEFAULT_INDEX for buffers, and DISP_STRING should be Qnil.) + */ -static Charbpos +static Charxpos generate_display_line (struct window *w, struct display_line *dl, int bounds, - Charbpos start_pos, prop_block_dynarr **prop, + Charxpos start_pos, prop_block_dynarr **prop, + Lisp_Object disp_string, face_index default_face, int type) { - Charbpos ret_charpos; + Charxpos ret_charpos; int overlay_width; - struct buffer *b = XBUFFER (WINDOW_BUFFER (w)); /* If our caller hasn't already set the boundaries, then do so now. */ if (!bounds) ＠＠ -972,21 +998,14 ＠＠ dl->modeline = 0; /* Create a display block for the text region of the line. */ - { - /* #### urk urk urk!!! Chuck fix this shit! */ - Bytebpos hacked_up_bytebpos = - create_text_block (w, dl, charbpos_to_bytebpos (b, start_pos), - prop, type); - if (hacked_up_bytebpos > BYTE_BUF_ZV (b)) - ret_charpos = BUF_ZV (b) + 1; - else - ret_charpos = bytebpos_to_charbpos (b, hacked_up_bytebpos); - } + ret_charpos = create_text_block (w, dl, start_pos, prop, disp_string, + default_face, type); dl->charpos = start_pos; if (dl->end_charpos < dl->charpos) dl->end_charpos = dl->charpos; - if (MARKERP (Voverlay_arrow_position) + if (NILP (disp_string) + && MARKERP (Voverlay_arrow_position) && EQ (w->buffer, Fmarker_buffer (Voverlay_arrow_position)) && start_pos == marker_position (Voverlay_arrow_position) && (STRINGP (Voverlay_arrow_string) ＠＠ -1000,17 +1019,18 ＠＠ /* If there are left glyphs associated with any character in the text block, then create a display block to handle them. */ if (dl->left_glyphs != NULL && Dynarr_length (dl->left_glyphs)) - create_left_glyph_block (w, dl, overlay_width); + create_left_or_right_glyph_block (w, dl, overlay_width, LEFT_GLYPHS); /* If there are right glyphs associated with any character in the text block, then create a display block to handle them. */ if (dl->right_glyphs != NULL && Dynarr_length (dl->right_glyphs)) - create_right_glyph_block (w, dl); + create_left_or_right_glyph_block (w, dl, 0, RIGHT_GLYPHS); /* In the future additional types of display blocks may be generated here. */ - w->last_redisplay_pos = ret_charpos; + if (NILP (disp_string)) + w->last_redisplay_pos = ret_charpos; return ret_charpos; } ＠＠ -1048,10 +1068,11 ＠＠ gb.extent = Qnil; gb.glyph = Vhscroll_glyph; + gb.matchspec = Qunbound; { int oldpixpos = data->pixpos; retval = add_glyph_rune (data, &gb, BEGIN_GLYPHS, 0, - GLYPH_CACHEL (XWINDOW (data->window), + glyph_cachel_from_index (XWINDOW (data->window), HSCROLL_GLYPH_INDEX)); data->hscroll_glyph_width_adjust = data->pixpos - oldpixpos - space_width (XWINDOW (data->window)); ＠＠ -1326,7 +1347,8 ＠＠ } /* Blank runes are always calculated to fit. */ - assert (data->pixpos + data->blank_width <= data->max_pixpos); + display_checking_assert (data->pixpos + data->blank_width <= + data->max_pixpos); rb.findex = data->findex; rb.xpos = data->pixpos; ＠＠ -1409,9 +1431,10 ＠＠ gb.extent = Qnil; gb.glyph = Voctal_escape_glyph; + gb.matchspec = Qunbound; add_failed = add_glyph_rune (data, &gb, BEGIN_GLYPHS, 1, - GLYPH_CACHEL (w, OCT_ESC_GLYPH_INDEX)); + glyph_cachel_from_index (w, OCT_ESC_GLYPH_INDEX)); } } ＠＠ -1489,11 +1512,12 ＠＠ gb.extent = Qnil; gb.glyph = Vcontrol_arrow_glyph; + gb.matchspec = Qunbound; /* We only propagate information if the glyph was partially added. */ if (add_glyph_rune (data, &gb, BEGIN_GLYPHS, 1, - GLYPH_CACHEL (w, CONTROL_GLYPH_INDEX))) + glyph_cachel_from_index (w, CONTROL_GLYPH_INDEX))) return ADD_FAILED; } } ＠＠ -1552,6 +1576,7 ＠＠ gb.glyph = entry; gb.extent = Qnil; + gb.matchspec = Qunbound; prop = add_glyph_rune (data, &gb, BEGIN_GLYPHS, 0, 0); } } ＠＠ -1783,11 +1808,21 ＠＠ return NULL; } } + +/* This routine has two purposes: -/* Add 'text layout glyphs at position POS_TYPE that are contained to - the display block, but add all other types to the appropriate list - of the display line. They will be added later by different - routines. */ + -- It's used when we are laying out the text of a line, and handles + begin and end glyphs from extents. In this case, POS_TYPE is + BEGIN_GLYPHS or END_GLYPHS. Glyphs whose layout policy is `text' will + be directly added to the display block; others will be accumulated in + the display line's left or right glyph block. + + -- It's used to handle the glyphs we accumulated in the previous step. + In this case, POS_TYPE is LEFT_GLYPHS or RIGHT_GLYPHS, and we add the + glyph to the appropriate display block (which is passed in to us through + DATA, since we might be adding to either the inside or outside margin + block). + */ static prop_block_dynarr * add_glyph_rune (pos_data *data, struct glyph_block *gb, int pos_type, ＠＠ -1797,15 +1832,15 ＠＠ /* If window faces changed, and glyph instance is text, then glyph sizes might have changed too */ - invalidate_glyph_geometry_maybe (gb->glyph, w); + invalidate_glyph_geometry_maybe (gb->glyph, w, glyph_block_matchspec (gb)); /* This makes sure the glyph is in the cachels. #### We do this to make sure the glyph is in the glyph cachels, so that the dirty flag can be reset after redisplay has finished. We should do this some other way, maybe by iterating - over the window cache of subwindows. */ - get_glyph_cachel_index (w, gb->glyph); + over the window cache of subcontrols. */ + record_glyph_cachel (w, gb->glyph, glyph_block_matchspec (gb)); /* A nil extent indicates a special glyph (ex. truncator). */ if (NILP (gb->extent) ＠＠ -1828,7 +1863,8 ＠＠ if (cachel) width = cachel->width; else - width = glyph_width (gb->glyph, data->window); + width = glyph_width (gb->glyph, data->window, + glyph_block_matchspec (gb)); if (!width) return NULL; ＠＠ -1914,8 +1950,10 ＠＠ } else { - ascent = glyph_ascent (gb->glyph, data->window); - descent = glyph_descent (gb->glyph, data->window); + ascent = glyph_ascent (gb->glyph, data->window, + glyph_block_matchspec (gb)); + descent = glyph_descent (gb->glyph, data->window, + glyph_block_matchspec (gb)); } baseline = glyph_baseline (gb->glyph, data->window); ＠＠ -1969,6 +2007,7 ＠＠ findex = get_builtin_face_cache_index (w, face); instance = glyph_image_instance (gb->glyph, data->window, + glyph_block_matchspec (gb), ERROR_ME_DEBUG_WARN, 1); if (TEXT_IMAGE_INSTANCEP (instance)) { ＠＠ -2002,6 +2041,7 ＠＠ rb.type = RUNE_DGLYPH; rb.object.dglyph.glyph = gb->glyph; rb.object.dglyph.extent = gb->extent; + rb.object.dglyph.matchspec = gb->matchspec; rb.object.dglyph.xoffset = xoffset; rb.object.dglyph.ascent = ascent; rb.object.dglyph.yoffset = 0; /* Until we know better, assume that it has ＠＠ -2103,20 +2143,71 ＠＠ return NULL; } + +/* Given a position for a buffer in a window, ensure that + the given display line DL accurately represents the text on a line + starting at the given position. + + Given a string and position in that string, ensure that + the given display line DL accurately represents the text of the string + starting at the given position. + + DISP_STRING and DEFAULT_FACE are used for string processing; + TYPE is for buffer processing. (TYPE is CURRENT_DISP, DESIRED_DISP, or + CMOTION_DISP, used only to retrieve the current point value for cursor + processing -- not used for strings. DEFAULT_FACE should always be + DEFAULT_INDEX for buffers, and DISP_STRING should be Qnil.) + + NOTE: Code duplication is bad bad bad. This was formerly split into + two almost identical functions, one for buffers and strings. Lots of + code (e.g. the extent code) handles buffers and strings together, and + there are inline functions/macros to make this easy. Logic duplication + is a sure-fire way to introduce creeping bugs, as people update one + of the versions and not the other. If you are thinking about code + duplication, contact ben instead! --ben -/* Given a position for a buffer in a window, ensure that the given - display line DL accurately represents the text on a line starting - at the given position. + [Andy wrote the following in justification of his code duplication: + + Yes, this is duplicating the code of create_text_block, but it + looked just too hard to change create_text_block to handle strings + *and* buffers. We already make a distinction between the two + elsewhere in the code so I think unifying them would require a + complete MULE rewrite. Besides, the other distinction is that these + functions cover text that the user *cannot edit* so we can remove + everything to do with cursors, minibuffers etc. Eventually the + modeline routines should be modified to use this code as it copes + with many more types of display situation. ] - NOTE NOTE NOTE NOTE: This function works with and returns Bytebpos's. - You must do appropriate conversion. */ + In point of fact, unifying them was not hard, and you simply put + if (!stringp) around buffer-only stuff. The stuff about the modeline + is useful, though. +*/ -static Bytebpos +static Charxpos create_text_block (struct window *w, struct display_line *dl, - Bytebpos byte_start_pos, prop_block_dynarr **prop, + Charxpos start_pos, prop_block_dynarr **prop, + Lisp_Object disp_string, face_index default_face, int type) { struct frame *f = XFRAME (w->frame); + + /* Andy writes: + + Note that a lot of the buffer controlled stuff has been left in + because you might well want to make use of it (selective display etc), + its just the buffer text that we do not use. However, it seems to be + possible for buffer to be nil sometimes so protect against this + case. + + struct buffer *b = BUFFERP (w->buffer) ? XBUFFER (w->buffer) : 0; + + #### It is seriously wrong to be processing a window with no buffer; + that would be a dead window. Fix the calling code, instead. + */ + int stringp = !NILP (disp_string); + Lisp_Object object = stringp ? disp_string : w->buffer; + Bytexpos byte_start_pos = + textobj_charxpos_to_bytexpos (object, start_pos); struct buffer *b = XBUFFER (w->buffer); struct device *d = XDEVICE (f->device); ＠＠ -2124,8 +2215,9 ＠＠ /* Don't display anything in the minibuffer if this window is not on a selected frame. We consider all other windows to be active - minibuffers as it simplifies the coding. */ - int active_minibuffer = (!MINI_WINDOW_P (w) || + minibuffers as it simplifies the coding. With strings, we are + always active. */ + int active_minibuffer = (stringp || !MINI_WINDOW_P (w) || (f == device_selected_frame (d)) || is_surrogate_for_selected_frame (f)); ＠＠ -2134,16 +2226,49 ＠＠ /* If the buffer's value of selective_display is an integer then only lines that start with less than selective_display columns of space will be displayed. If selective_display is t then all text - after a ^M is invisible. */ - int selective = (INTP (b->selective_display) - ? XINT (b->selective_display) - : (!NILP (b->selective_display) ? -1 : 0)); + after a ^M is invisible. + + #### Should selective_display apply to strings? Probably not. + I originally set selective to 0 here for strings, but I now think + it's cleaner to just put !stringp everywhere that selective-display code + occurs, so we know it's just being disabled and that some work might + need to be done on the code if we ever figure out what it means to + do selective display on strings and how it should work. */ + int selective = (INTP (b->selective_display) ? XINT (b->selective_display) : + !NILP (b->selective_display) ? -1 : 0); /* The variable ctl-arrow allows the user to specify what characters can actually be displayed and which octal should be used for. #### This variable should probably have some rethought done to it. + #### It would also be really nice if you could specify that + the characters come out in hex instead of in octal. Mule + does that by adding a ctl-hexa variable similar to ctl-arrow, + but that's bogus -- we need a more general solution. I + think you need to extend the concept of display tables + into a more general conversion mechanism. Ideally you + could specify a Lisp function that converts characters, + but this violates the Second Golden Rule and besides would + make things way way way way slow. + + So instead, we extend the display-table concept, which was + historically limited to 256-byte vectors, to one of the + following: + + a) A 256-entry vector, for backward compatibility; + b) char-table, mapping characters to values; + c) range-table, mapping ranges of characters to values; + d) a list of the above. + + The (d) option allows you to specify multiple display tables + instead of just one. Each display table can specify conversions + for some characters and leave others unchanged. The way the + character gets displayed is determined by the first display table + with a binding for that character. This way, you could call a + function `enable-hex-display' that adds a hex display-table to + the list of display tables for the current buffer. + See also (Info-goto-node "(internals)Future Work -- Display Tables") ＠＠ -2175,33 +2300,57 ＠＠ dl->num_chars = 0; dl->line_continuation = 0; + if (stringp) + { + /* set up faces to use for clearing areas, used by + output_display_line */ + dl->default_findex = default_face; + if (default_face) + { + dl->left_margin_findex = default_face; + dl->right_margin_findex = default_face; + } + else + { + dl->left_margin_findex = + get_builtin_face_cache_index (w, Vleft_margin_face); + dl->right_margin_findex = + get_builtin_face_cache_index (w, Vright_margin_face); + } + } + xzero (data); - data.ef = extent_fragment_new (w->buffer, f); + data.ef = extent_fragment_new (stringp ? disp_string : w->buffer, f); /* These values are used by all of the rune addition routines. We add them to this structure for ease of passing. */ data.d = d; data.window = wrap_window (w); - data.string = Qnil; + data.string = disp_string; data.db = db; data.dl = dl; data.byte_charpos = byte_start_pos; data.pixpos = dl->bounds.left_in; data.last_charset = Qunbound; - data.last_findex = DEFAULT_INDEX; + data.last_findex = default_face; data.result_str = Qnil; /* Set the right boundary adjusting it to take into account any end glyph. Save the width of the end glyph for later use. */ data.max_pixpos = dl->bounds.right_in; - if (truncate_win) - data.end_glyph_width = GLYPH_CACHEL_WIDTH (w, TRUN_GLYPH_INDEX); - else - data.end_glyph_width = GLYPH_CACHEL_WIDTH (w, CONT_GLYPH_INDEX); + if (!stringp) + { + if (truncate_win) + data.end_glyph_width = glyph_cachel_width (w, TRUN_GLYPH_INDEX); + else + data.end_glyph_width = glyph_cachel_width (w, CONT_GLYPH_INDEX); + } data.max_pixpos -= data.end_glyph_width; - if (cursor_in_echo_area && MINI_WINDOW_P (w) && echo_area_active (f)) + if (stringp) + data.cursor_type = NO_CURSOR; + else if (cursor_in_echo_area && MINI_WINDOW_P (w) && echo_area_active (f)) { data.byte_cursor_charpos = BYTE_BUF_ZV (b); data.cursor_type = CURSOR_ON; ＠＠ -2225,10 +2374,12 ＠＠ data.cursor_type = NO_CURSOR; data.cursor_x = -1; - data.start_col = w->hscroll; - data.start_col_xoffset = w->left_xoffset; - data.byte_start_col_enabled = (w->hscroll ? byte_start_pos : 0); - data.hscroll_glyph_width_adjust = 0; + if (!stringp) + { /* string areas should not scroll with the window */ + data.start_col = w->hscroll; + data.start_col_xoffset = w->left_xoffset; + data.byte_start_col_enabled = (w->hscroll ? byte_start_pos : 0); + } /* We regenerate the line from the very beginning. */ Dynarr_reset (db->runes); ＠＠ -2263,7 +2414,7 ＠＠ && (active_minibuffer || !NILP (synch_minibuffers_value))) { /* #### This check probably should not be necessary. */ - if (data.byte_charpos > BYTE_BUF_ZV (b)) + if (data.byte_charpos > textobj_accessible_end_byte (object)) { /* #### urk! More of this lossage! */ data.byte_charpos--; ＠＠ -2273,9 +2424,10 ＠＠ /* If selective display was an integer and we aren't working on a continuation line then find the next line we are actually supposed to display. */ - if (selective > 0 + if (!stringp && selective > 0 && (data.byte_charpos == BYTE_BUF_BEGV (b) - || BUF_FETCH_CHAR (b, prev_bytebpos (b, data.byte_charpos)) == '\n')) + || BUF_ICHAR_AT (b, prev_bytebpos (b, data.byte_charpos)) == + '\n')) { while (byte_spaces_at_point (b, data.byte_charpos) >= selective) { ＠＠ -2309,8 +2461,14 ＠＠ } /* Now compute the face and begin/end-glyph information. */ data.findex = - /* Remember that the extent-fragment routines deal in Bytebpos's. */ + /* Remember that the extent-fragment routines deal in + Bytexpos's. */ extent_fragment_update (w, data.ef, data.byte_charpos, last_glyph); + /* This is somewhat cheesy but the alternative is to + propagate default_face into extent_fragment_update. + #### And what's wrong with that? --ben */ + if (data.findex == DEFAULT_INDEX) + data.findex = default_face; get_display_tables (w, data.findex, &face_dt, &window_dt); ＠＠ -2351,8 +2509,9 ＠＠ data.ef->invisible_ellipses = 0; gb.extent = Qnil; gb.glyph = Vinvisible_text_glyph; + gb.matchspec = Qunbound; *prop = add_glyph_rune (&data, &gb, BEGIN_GLYPHS, 0, - GLYPH_CACHEL (w, INVIS_GLYPH_INDEX)); + glyph_cachel_from_index (w, INVIS_GLYPH_INDEX)); /* Perhaps they shouldn't propagate if the very next thing is to display a newline (for compatibility with selective-display-ellipses)? Maybe that's too ＠＠ -2373,10 +2532,11 ＠＠ if (data.start_col) data.start_col--; - if (data.byte_charpos == BYTE_BUF_ZV (b)) + if (data.byte_charpos == + textobj_accessible_end_byte (object)) goto done; else - INC_BYTEBPOS (b, data.byte_charpos); + INC_BYTEXPOS (object, data.byte_charpos); } /* If there is propagation data, then it represents the current ＠＠ -2390,13 +2550,16 ＠＠ if (*prop) goto done; /* gee, a really narrow window */ - else if (data.byte_charpos == BYTE_BUF_ZV (b)) + else if (data.byte_charpos == + textobj_accessible_end_byte (object)) goto done; - else if (data.byte_charpos < BYTE_BUF_BEGV (b)) + else if (data.byte_charpos < + textobj_accessible_begin_byte (object)) /* #### urk urk urk! Aborts are not very fun! Fix this please! */ - data.byte_charpos = BYTE_BUF_BEGV (b); + data.byte_charpos = + textobj_accessible_begin_byte (object); else - INC_BYTEBPOS (b, data.byte_charpos); + INC_BYTEXPOS (object, data.byte_charpos); } /* If there are end glyphs, add them to the line. These are ＠＠ -2407,9 +2570,10 ＠＠ else if (Dynarr_length (data.ef->end_glyphs) > 0 || Dynarr_length (data.ef->begin_glyphs) > 0) { - glyph_block_dynarr* tmpglyphs = 0; + glyph_block_dynarr *tmpglyphs = 0; /* #### I think this is safe, but could be wrong. */ - data.ch = BYTE_BUF_FETCH_CHAR (b, data.byte_charpos); + data.ch = + textobj_ichar_at_byte (object, data.byte_charpos); if (Dynarr_length (data.ef->end_glyphs) > 0) { ＠＠ -2429,8 +2593,10 ＠＠ /* If we just clipped a glyph and we are at the end of a line and there are more glyphs to display then do appropriate processing to not get a continuation - glyph. */ - if (*prop != ADD_FAILED + glyph. Ignore this entirely for string processing, + where there's no cursor and no continuation glyphs. */ + if (!stringp && + *prop != ADD_FAILED && Dynarr_atp (*prop, 0)->type == PROP_GLYPH && data.ch == '\n') { ＠＠ -2462,14 +2628,15 ＠＠ /* If at end-of-buffer, we've already processed begin and end-glyphs at this point and there's no text to process, so we're done. */ - else if (data.byte_charpos == BYTE_BUF_ZV (b)) + else if (data.byte_charpos == + textobj_accessible_end_byte (object)) goto done; else { Lisp_Object entry = Qnil; /* Get the character at the current buffer position. */ - data.ch = BYTE_BUF_FETCH_CHAR (b, data.byte_charpos); + data.ch = textobj_ichar_at_byte (object, data.byte_charpos); if (!NILP (face_dt) || !NILP (window_dt)) entry = display_table_entry (data.ch, face_dt, window_dt); ＠＠ -2492,6 +2659,9 ＠＠ fit. */ data.max_pixpos += data.end_glyph_width; + if (stringp) /* Skip all the selective-display/cursor stuff */ + goto done; + if (selective > 0 && (byte_spaces_at_point (b, next_bytebpos (b, data.byte_charpos)) ＠＠ -2503,8 +2673,9 ＠＠ gb.extent = Qnil; gb.glyph = Vinvisible_text_glyph; + gb.matchspec = Qunbound; add_glyph_rune (&data, &gb, BEGIN_GLYPHS, 0, - GLYPH_CACHEL (w, INVIS_GLYPH_INDEX)); + glyph_cachel_from_index (w, INVIS_GLYPH_INDEX)); } else { ＠＠ -2532,7 +2703,7 ＠＠ break; } } - if (BYTE_BUF_FETCH_CHAR + if (BYTE_BUF_ICHAR_AT (b, prev_bytebpos (b, data.byte_charpos)) == '\n') DEC_BYTEBPOS (b, data.byte_charpos); } ＠＠ -2549,14 +2720,14 ＠＠ enabled, then add the invisible-text-glyph if selective-display-ellipses is set. In any case, this line is done. */ - else if (data.ch == (('M' & 037)) && selective == -1) + else if (!stringp && data.ch == (('M' & 037)) && selective == -1) { Bytebpos byte_next_charpos; /* Find the buffer position at the end of the line. */ byte_next_charpos = byte_find_next_newline_no_quit (b, data.byte_charpos, 1); - if (BYTE_BUF_FETCH_CHAR (b, prev_bytebpos (b, byte_next_charpos)) + if (BYTE_BUF_ICHAR_AT (b, prev_bytebpos (b, byte_next_charpos)) == '\n') DEC_BYTEBPOS (b, byte_next_charpos); ＠＠ -2582,8 +2753,9 ＠＠ gb.extent = Qnil; gb.glyph = Vinvisible_text_glyph; + gb.matchspec = Qunbound; add_glyph_rune (&data, &gb, BEGIN_GLYPHS, 1, - GLYPH_CACHEL (w, INVIS_GLYPH_INDEX)); + glyph_cachel_from_index (w, INVIS_GLYPH_INDEX)); } /* Set the buffer position to the end of the line. We ＠＠ -2610,7 +2782,7 ＠＠ /* This had better be a newline but doing it this way we'll see obvious incorrect results if it isn't. No need to abort here. */ - data.ch = BYTE_BUF_FETCH_CHAR (b, data.byte_charpos); + data.ch = BYTE_BUF_ICHAR_AT (b, data.byte_charpos); goto done; } ＠＠ -2635,8 +2807,12 ＠＠ int prop_width = 0; if (data.start_col > 1) - tab_start_pixpos -= (space_width (w) * (data.start_col - 1)) - + data.start_col_xoffset; + { + tab_start_pixpos -= (space_width (w) * (data.start_col - 1)) + + data.start_col_xoffset; + display_checking_assert (data.start_col_xoffset == 0 || + !stringp); + } next_tab_start = next_tab_position (w, tab_start_pixpos, ＠＠ -2655,7 +2831,7 ＠＠ /* add_blank_rune is only supposed to be called with sizes guaranteed to fit in the available space. */ - assert (!(*prop)); + display_checking_assert (!(*prop)); if (prop_width) { ＠＠ -2706,7 +2882,7 ＠＠ goto done; } - INC_BYTEBPOS (b, data.byte_charpos); + INC_BYTEXPOS (object, data.byte_charpos); } } ＠＠ -2714,7 +2890,7 ＠＠ /* Determine the starting point of the next line if we did not hit the end of the buffer. */ - if (data.byte_charpos < BYTE_BUF_ZV (b) + if (data.byte_charpos < textobj_accessible_end_byte (object) && (active_minibuffer || !NILP (synch_minibuffers_value))) { /* #### This check is not correct. If the line terminated ＠＠ -2736,6 +2912,7 ＠＠ line in that case unless the line is completely blank. */ if (data.byte_start_col_enabled) { + display_checking_assert (!stringp); if (data.cursor_type == CURSOR_ON) { if (data.byte_cursor_charpos >= byte_start_pos ＠＠ -2752,8 +2929,9 ＠＠ gb.extent = Qnil; gb.glyph = Vhscroll_glyph; + gb.matchspec = Qunbound; add_glyph_rune (&data, &gb, BEGIN_GLYPHS, 0, - GLYPH_CACHEL (w, HSCROLL_GLYPH_INDEX)); + glyph_cachel_from_index (w, HSCROLL_GLYPH_INDEX)); } else { ＠＠ -2766,7 +2944,7 ＠＠ } } - INC_BYTEBPOS (b, data.byte_charpos); + INC_BYTEXPOS (object, data.byte_charpos); } /* Otherwise we have a buffer line which cannot fit on one display ＠＠ -2781,15 +2959,17 ＠＠ we know will fit because we adjusted the right border before we starting laying out the line. */ data.max_pixpos += data.end_glyph_width; - data.findex = DEFAULT_INDEX; + data.findex = default_face; gb.extent = Qnil; + gb.matchspec = Qunbound; if (truncate_win) { Bytebpos byte_pos; /* Now find the start of the next line. */ - byte_pos = byte_find_next_newline_no_quit (b, data.byte_charpos, 1); + byte_pos = (textobj_byte_find_next_ichar_no_quit + (object, '\n', data.byte_charpos, 1)); /* If the cursor is past the truncation line then we make it appear on the truncation glyph. If we've hit ＠＠ -2797,12 +2977,12 ＠＠ appear unless eob is immediately preceded by a newline. In that case the cursor should actually appear on the next line. */ - if (data.cursor_type == CURSOR_ON + if (!stringp && data.cursor_type == CURSOR_ON && data.byte_cursor_charpos >= data.byte_charpos && (data.byte_cursor_charpos < byte_pos || (byte_pos == BYTE_BUF_ZV (b) && (byte_pos == BYTE_BUF_BEGV (b) - || (BYTE_BUF_FETCH_CHAR (b, prev_bytebpos (b, byte_pos)) + || (BYTE_BUF_ICHAR_AT (b, prev_bytebpos (b, byte_pos)) != '\n'))))) data.byte_cursor_charpos = byte_pos; else ＠＠ -2810,7 +2990,7 ＠＠ data.byte_charpos = byte_pos; gb.glyph = Vtruncation_glyph; - cachel = GLYPH_CACHEL (w, TRUN_GLYPH_INDEX); + cachel = glyph_cachel_from_index (w, TRUN_GLYPH_INDEX); } else { ＠＠ -2821,18 +3001,24 ＠＠ dl->line_continuation = 1; gb.glyph = Vcontinuation_glyph; - cachel = GLYPH_CACHEL (w, CONT_GLYPH_INDEX); + cachel = glyph_cachel_from_index (w, CONT_GLYPH_INDEX); } - add_glyph_rune (&data, &gb, BEGIN_GLYPHS, 0, cachel); + if (!stringp || data.end_glyph_width) /* #### I don't understand */ + add_glyph_rune (&data, &gb, BEGIN_GLYPHS, 0, cachel); - if (truncate_win && data.byte_charpos == BYTE_BUF_ZV (b) - && BYTE_BUF_FETCH_CHAR (b, prev_bytebpos (b, BYTE_BUF_ZV (b))) != '\n') + if (truncate_win && data.byte_charpos == + textobj_accessible_end_byte (object) && + textobj_ichar_at_byte + (object, + prev_bytexpos + (object, textobj_accessible_end_byte (object))) != '\n') /* #### Damn this losing shit. */ data.byte_charpos++; } } - else if ((active_minibuffer || !NILP (synch_minibuffers_value)) + else if (!stringp + && (active_minibuffer || !NILP (synch_minibuffers_value)) && (!echo_area_active (f) || data.byte_charpos == BYTE_BUF_ZV (b))) { /* We need to add a marker to the end of the line since there is no ＠＠ -2840,6 +3026,12 ＠＠ it as a newline so that it gets handled correctly by the whitespace routines below. */ + /* Andy writes: + + create_text_block () adds a bogus \n marker here which screws + up subcontrol display. Since we never have a cursor in the + gutter we can safely ignore it. */ + data.ch = '\n'; data.blank_width = DEVMETH (d, eol_cursor_width, ()); data.findex = DEFAULT_INDEX; ＠＠ -2937,12 +3129,14 ＠＠ dl->cursor_elt = data.cursor_x; /* #### lossage lossage lossage! Fix this shit! */ - if (data.byte_charpos > BYTE_BUF_ZV (b)) - dl->end_charpos = BUF_ZV (b); + if (data.byte_charpos > textobj_accessible_end_byte (object)) + dl->end_charpos = textobj_accessible_end_char (object); else - dl->end_charpos = bytebpos_to_charbpos (b, data.byte_charpos) - 1; + dl->end_charpos = + textobj_bytexpos_to_charxpos (object, data.byte_charpos) - 1; if (truncate_win) - data.dl->num_chars = column_at_point (b, dl->end_charpos, 0); + data.dl->num_chars = + column_at_point (object, dl->end_charpos, XINT (b->tab_width), 0); else /* This doesn't correctly take into account tabs and control characters but if the window isn't being truncated then this ＠＠ -2970,10 +3164,21 ＠＠ The main loop should get fixed so that it isn't necessary to call this function if we are already at EOB. */ - if (data.byte_charpos == BYTE_BUF_ZV (b) && byte_start_pos == BYTE_BUF_ZV (b)) - return data.byte_charpos + 1; /* Yuck! */ - else - return data.byte_charpos; + { + Bytexpos byte_retval; + + if (data.byte_charpos == textobj_accessible_end_byte (object) + && byte_start_pos == textobj_accessible_end_byte (object)) + byte_retval = data.byte_charpos + 1; /* Yuck! */ + else + byte_retval = data.byte_charpos; + + /* #### urk urk urk!!! Chuck fix this shit! */ + if (byte_retval > textobj_accessible_end_byte (object)) + return textobj_accessible_end_char (object) + 1; + else + return textobj_bytexpos_to_charxpos (object, byte_retval); + } } /* Display the overlay arrow at the beginning of the given line. */ ＠＠ -3021,6 +3226,7 ＠＠ gb.glyph = Voverlay_arrow_string; gb.extent = Qnil; + gb.matchspec = Qunbound; add_glyph_rune (&data, &gb, BEGIN_GLYPHS, 0, 0); } ＠＠ -3052,7 +3258,8 ＠＠ static int add_margin_runes (struct display_line *dl, struct display_block *db, int start, - int count, enum glyph_layout layout, int side, Lisp_Object window) + int count, enum glyph_layout layout, int side, + Lisp_Object window) { glyph_block_dynarr *gbd = (side == LEFT_GLYPHS ? dl->left_glyphs ＠＠ -3101,10 +3308,7 ＠＠ ABORT (); /* these should have been handled in add_glyph_rune */ if (gb->active && - ((side == LEFT_GLYPHS && - extent_begin_glyph_layout (XEXTENT (gb->extent)) == layout) - || (side == RIGHT_GLYPHS && - extent_end_glyph_layout (XEXTENT (gb->extent)) == layout))) + extent_glyph_layout (XEXTENT (gb->extent), side) == layout) { data.findex = gb->findex; data.max_pixpos = data.pixpos + gb->width; ＠＠ -3147,22 +3351,53 ＠＠ Dynarr_add (db->runes, rb); } -/* Display glyphs in the left outside margin, left inside margin and - left whitespace area. */ +/* NOTE: This function was formerly split into two. There is a fair amount + of conditionalizing below on left vs. right, due to two factors: + -- the left side has to deal with the overlay_width (the special + overlay-arrow-string hack), and the right side doesn't; + -- but especially, the fact that the orders of layout are reversed. + + #### There probably should be a clean way of abstracting this layout. + + It could be argued that the function should stay split in two, given the + conditionalizing; it seems "cleaner" to look at a particular function + without worrying about left vs. right. But this is exactly the fallacy + that leads to code duplication in general -- the danger of creeping + differences due to someone changing one version and not the other is a + far greater concern than the apparent additional cleanliness from + splitting the two. Keeping it unified forces anyone who makes a change + to do it equally for both versions. --ben + + */ static void -create_left_glyph_block (struct window *w, struct display_line *dl, - int overlay_width) +create_left_or_right_glyph_block (struct window *w, struct display_line *dl, + /* overlay_width used only for left side */ + int overlay_width, + /* SIDE is LEFT_GLYPHS or RIGHT_GLYPHS */ + int side) { Lisp_Object window; - - int use_overflow = (NILP (w->use_left_overflow) ? 0 : 1); + int leftp = side == LEFT_GLYPHS ? 1 : 0; + glyph_block_dynarr *side_glyphs = leftp ? dl->left_glyphs : dl->right_glyphs; + enum display_type inside_margin_side = + leftp ? LEFT_INSIDE_MARGIN : RIGHT_INSIDE_MARGIN; + enum display_type outside_margin_side = + leftp ? LEFT_OUTSIDE_MARGIN : RIGHT_OUTSIDE_MARGIN; + int use_overflow = (NILP (leftp ? w->use_left_overflow : + w->use_right_overflow) ? 0 : 1); int elt, end_xpos; - int out_end, in_out_start, in_in_end, white_out_start, white_in_start; int out_cnt, in_out_cnt, in_in_cnt, white_out_cnt, white_in_cnt; - int left_in_start = dl->bounds.left_in; + + /* Used for left side */ + int out_end = 0, in_out_start = 0, in_in_end = 0, white_out_start = 0; + int white_in_start = 0; int left_in_end = dl->bounds.left_in + overlay_width; + /* Used for right side */ + int out_start = 0, in_out_end = 0, in_in_start = 0, white_out_end = 0; + int white_in_end = 0; + struct display_block *odb, *idb; window = wrap_window (w); ＠＠ -3173,41 +3408,74 ＠＠ /* Determine how many whitespace glyphs we can display and where they should start. */ - white_in_start = dl->bounds.left_white; - white_out_start = left_in_start; + if (leftp) + { + white_in_start = dl->bounds.left_white; + white_out_start = dl->bounds.left_in; + } + else + { + white_in_end = dl->bounds.right_white; + white_out_end = dl->bounds.right_in; + } + white_out_cnt = white_in_cnt = 0; elt = 0; - while (elt < Dynarr_length (dl->left_glyphs)) + while (elt < Dynarr_length (side_glyphs)) { - struct glyph_block *gb = Dynarr_atp (dl->left_glyphs, elt); + struct glyph_block *gb = Dynarr_atp (side_glyphs, elt); if (NILP (gb->extent)) ABORT (); /* these should have been handled in add_glyph_rune */ - if (extent_begin_glyph_layout (XEXTENT (gb->extent)) == GL_WHITESPACE) + if (extent_glyph_layout (XEXTENT (gb->extent), side) == GL_WHITESPACE) { int width; - width = glyph_width (gb->glyph, window); + width = glyph_width (gb->glyph, window, glyph_block_matchspec (gb)); - if (white_in_start - width >= left_in_end) + if (leftp) { - white_in_cnt++; - white_in_start -= width; - gb->width = width; - gb->active = 1; - } - else if (use_overflow - && (white_out_start - width > dl->bounds.left_out)) - { - white_out_cnt++; - white_out_start -= width; - gb->width = width; - gb->active = 1; + if (white_in_start - width >= left_in_end) + { + white_in_cnt++; + white_in_start -= width; + gb->width = width; + gb->active = 1; + } + else if (use_overflow + && (white_out_start - width > dl->bounds.left_out)) + { + white_out_cnt++; + white_out_start -= width; + gb->width = width; + gb->active = 1; + } + else + gb->active = 0; } else - gb->active = 0; + { + if (white_in_end + width <= dl->bounds.right_in) + { + white_in_cnt++; + white_in_end += width; + gb->width = width; + gb->active = 1; + } + else if (use_overflow + && (white_out_end + width <= dl->bounds.right_out)) + { + white_out_cnt++; + white_out_end += width; + gb->width = width; + gb->active = 1; + } + else + gb->active = 0; + } + } elt++; ＠＠ -3230,17 +3498,18 ＠＠ elt = 0; used_in = used_out = 0; ib = Dynarr_new (glyph_block); - while (elt < Dynarr_length (dl->left_glyphs)) + while (elt < Dynarr_length (side_glyphs)) { - struct glyph_block *gb = Dynarr_atp (dl->left_glyphs, elt); + struct glyph_block *gb = Dynarr_atp (side_glyphs, elt); if (NILP (gb->extent)) ABORT (); /* these should have been handled in add_glyph_rune */ - if (extent_begin_glyph_layout (XEXTENT (gb->extent)) == + if (extent_glyph_layout (XEXTENT (gb->extent), side) == GL_INSIDE_MARGIN) { - gb->width = glyph_width (gb->glyph, window); + gb->width = glyph_width (gb->glyph, window, + glyph_block_matchspec (gb)); used_in += gb->width; Dynarr_add (ib, *gb); } ＠＠ -3250,17 +3519,21 ＠＠ if (white_out_cnt) avail_in = 0; - else + else if (leftp) { avail_in = white_in_start - left_in_end; if (avail_in < 0) avail_in = 0; } + else + avail_in = dl->bounds.right_in - white_in_end; if (!use_overflow) avail_out = 0; - else + else if (leftp) avail_out = white_out_start - dl->bounds.left_out; + else + avail_out = dl->bounds.right_out - white_out_end; marker = 0; while (!done && marker < Dynarr_length (ib)) ＠＠ -3292,42 +3565,76 ＠＠ the inside margin and everything before it goes in the outside margin. The stuff going into the outside margin is guaranteed to fit, but we may have to trim some stuff from the inside. */ + + if (leftp) + { + in_in_end = left_in_end; + in_out_start = white_out_start; + } + else + { + in_in_start = dl->bounds.right_in; + in_out_end = dl->bounds.right_in; + } - in_in_end = left_in_end; - in_out_start = white_out_start; in_out_cnt = in_in_cnt = 0; Dynarr_free (ib); elt = 0; - while (elt < Dynarr_length (dl->left_glyphs)) + while (elt < Dynarr_length (side_glyphs)) { - struct glyph_block *gb = Dynarr_atp (dl->left_glyphs, elt); + struct glyph_block *gb = Dynarr_atp (side_glyphs, elt); if (NILP (gb->extent)) ABORT (); /* these should have been handled in add_glyph_rune */ - if (extent_begin_glyph_layout (XEXTENT (gb->extent)) == + if (extent_glyph_layout (XEXTENT (gb->extent), side) == GL_INSIDE_MARGIN) { - int width = glyph_width (gb->glyph, window); + int width = glyph_width (gb->glyph, window, + glyph_block_matchspec (gb)); - if (used_out) + if (leftp) { - in_out_cnt++; - in_out_start -= width; - gb->width = width; - gb->active = 1; - used_out -= width; + if (used_out) + { + in_out_cnt++; + in_out_start -= width; + gb->width = width; + gb->active = 1; + used_out -= width; + } + else if (in_in_end + width < white_in_start) + { + in_in_cnt++; + in_in_end += width; + gb->width = width; + gb->active = 1; + } + else + gb->active = 0; } - else if (in_in_end + width < white_in_start) + else { - in_in_cnt++; - in_in_end += width; - gb->width = width; - gb->active = 1; + if (used_out) + { + in_out_cnt++; + in_out_end += width; + gb->width = width; + gb->active = 1; + used_out -= width; + } + else if (in_in_start - width >= white_in_end) + { + in_in_cnt++; + in_in_start -= width; + gb->width = width; + gb->active = 1; + } + else + gb->active = 0; } - else - gb->active = 0; + } elt++; ＠＠ -3335,33 +3642,50 ＠＠ } /* Determine how many outside margin glyphs we can display. They - always start at the left outside margin and can only use the + always start at the left or right outside margin and can only use the outside margin space. */ - out_end = dl->bounds.left_out; + out_end = leftp ? dl->bounds.left_out : dl->bounds.right_out; out_cnt = 0; elt = 0; - while (elt < Dynarr_length (dl->left_glyphs)) + while (elt < Dynarr_length (side_glyphs)) { - struct glyph_block *gb = Dynarr_atp (dl->left_glyphs, elt); + struct glyph_block *gb = Dynarr_atp (side_glyphs, elt); if (NILP (gb->extent)) ABORT (); /* these should have been handled in add_glyph_rune */ - if (extent_begin_glyph_layout (XEXTENT (gb->extent)) == + if (extent_glyph_layout (XEXTENT (gb->extent), side) == GL_OUTSIDE_MARGIN) { - int width = glyph_width (gb->glyph, window); + int width = glyph_width (gb->glyph, window, + glyph_block_matchspec (gb)); - if (out_end + width <= in_out_start) + if (leftp) { - out_cnt++; - out_end += width; - gb->width = width; - gb->active = 1; + if (out_end + width <= in_out_start) + { + out_cnt++; + out_end += width; + gb->width = width; + gb->active = 1; + } + else + gb->active = 0; } else - gb->active = 0; + { + if (out_start - width >= in_out_end) + { + out_cnt++; + out_start -= width; + gb->width = width; + gb->active = 1; + } + else + gb->active = 0; + } + } elt++; ＠＠ -3371,12 +3695,21 ＠＠ runes to the appropriate display blocks. */ if (out_cnt || in_out_cnt || white_out_cnt) { - odb = get_display_block_from_line (dl, LEFT_OUTSIDE_MARGIN); - odb->start_pos = dl->bounds.left_out; - /* #### We should stop adding a blank to account for the space - between the end of the glyphs and the margin and instead set - this accordingly. */ - odb->end_pos = dl->bounds.left_in; + odb = get_display_block_from_line (dl, outside_margin_side); + if (leftp) + { + odb->start_pos = dl->bounds.left_out; + /* #### We should stop adding a blank to account for the space + between the end of the glyphs and the margin and instead set + this accordingly. */ + odb->end_pos = dl->bounds.left_in; + } + else + { + odb->start_pos = dl->bounds.right_in; + odb->end_pos = dl->bounds.right_out; + } + Dynarr_reset (odb->runes); } else ＠＠ -3384,394 +3717,176 ＠＠ if (in_in_cnt || white_in_cnt) { - idb = get_display_block_from_line (dl, LEFT_INSIDE_MARGIN); - idb->start_pos = dl->bounds.left_in; - /* #### See above comment for odb->end_pos */ - idb->end_pos = dl->bounds.left_white; + idb = get_display_block_from_line (dl, inside_margin_side); + if (leftp) + { + idb->start_pos = dl->bounds.left_in; + /* #### See above comment for odb->end_pos */ + idb->end_pos = dl->bounds.left_white; + } + else + { + idb->start_pos = dl->bounds.right_white; + idb->end_pos = dl->bounds.right_in; + } Dynarr_reset (idb->runes); } else idb = 0; - - /* First add the outside margin glyphs. */ - if (out_cnt) - end_xpos = add_margin_runes (dl, odb, dl->bounds.left_out, out_cnt, - GL_OUTSIDE_MARGIN, LEFT_GLYPHS, window); - else - end_xpos = dl->bounds.left_out; - - /* There may be blank space between the outside margin glyphs and - the inside margin glyphs. If so, add a blank. */ - if (in_out_cnt && (in_out_start - end_xpos)) - { - add_margin_blank (dl, odb, w, end_xpos, in_out_start - end_xpos, - LEFT_GLYPHS); - } - - /* Next add the inside margin glyphs which are actually in the - outside margin. */ - if (in_out_cnt) - { - end_xpos = add_margin_runes (dl, odb, in_out_start, in_out_cnt, - GL_INSIDE_MARGIN, LEFT_GLYPHS, window); - } - - /* If we didn't add any inside margin glyphs to the outside margin, - but are adding whitespace glyphs, then we need to add a blank - here. */ - if (!in_out_cnt && white_out_cnt && (white_out_start - end_xpos)) - { - add_margin_blank (dl, odb, w, end_xpos, white_out_start - end_xpos, - LEFT_GLYPHS); - } - - /* Next add the whitespace margin glyphs which are actually in the - outside margin. */ - if (white_out_cnt) - { - end_xpos = add_margin_runes (dl, odb, white_out_start, white_out_cnt, - GL_WHITESPACE, LEFT_GLYPHS, window); - } - /* We take care of clearing between the end of the glyphs and the - start of the inside margin for lines which have glyphs. */ - if (odb && (left_in_start - end_xpos)) + if (leftp) { - add_margin_blank (dl, odb, w, end_xpos, left_in_start - end_xpos, - LEFT_GLYPHS); - } + /* First add the outside margin glyphs. */ + if (out_cnt) + end_xpos = add_margin_runes (dl, odb, dl->bounds.left_out, out_cnt, + GL_OUTSIDE_MARGIN, side, window); + else + end_xpos = dl->bounds.left_out; - /* Next add the inside margin glyphs which are actually in the - inside margin. */ - if (in_in_cnt) - { - end_xpos = add_margin_runes (dl, idb, left_in_end, in_in_cnt, - GL_INSIDE_MARGIN, LEFT_GLYPHS, window); - } - else - end_xpos = left_in_end; + /* There may be blank space between the outside margin glyphs and + the inside margin glyphs. If so, add a blank. */ + if (in_out_cnt && (in_out_start - end_xpos)) + { + add_margin_blank (dl, odb, w, end_xpos, in_out_start - end_xpos, + side); + } - /* Make sure that the area between the end of the inside margin - glyphs and the whitespace glyphs is cleared. */ - if (idb && (white_in_start - end_xpos > 0)) - { - add_margin_blank (dl, idb, w, end_xpos, white_in_start - end_xpos, - LEFT_GLYPHS); - } + /* Next add the inside margin glyphs which are actually in the + outside margin. */ + if (in_out_cnt) + { + end_xpos = add_margin_runes (dl, odb, in_out_start, in_out_cnt, + GL_INSIDE_MARGIN, side, window); + } - /* Next add the whitespace margin glyphs which are actually in the - inside margin. */ - if (white_in_cnt) - { - add_margin_runes (dl, idb, white_in_start, white_in_cnt, GL_WHITESPACE, - LEFT_GLYPHS, window); - } + /* If we didn't add any inside margin glyphs to the outside margin, + but are adding whitespace glyphs, then we need to add a blank + here. */ + if (!in_out_cnt && white_out_cnt && (white_out_start - end_xpos)) + { + add_margin_blank (dl, odb, w, end_xpos, white_out_start - end_xpos, + side); + } - /* Whitespace glyphs always end right next to the text block so - there is nothing we have to make sure is cleared after them. */ -} + /* Next add the whitespace margin glyphs which are actually in the + outside margin. */ + if (white_out_cnt) + { + end_xpos = add_margin_runes (dl, odb, white_out_start, white_out_cnt, + GL_WHITESPACE, side, window); + } -/* Display glyphs in the right outside margin, right inside margin and - right whitespace area. */ + /* We take care of clearing between the end of the glyphs and the + start of the inside margin for lines which have glyphs. */ + if (odb && (dl->bounds.left_in - end_xpos)) + { + add_margin_blank (dl, odb, w, end_xpos, + dl->bounds.left_in - end_xpos, + side); + } -static void -create_right_glyph_block (struct window *w, struct display_line *dl) -{ - Lisp_Object window; + /* Next add the inside margin glyphs which are actually in the + inside margin. */ + if (in_in_cnt) + { + end_xpos = add_margin_runes (dl, idb, left_in_end, in_in_cnt, + GL_INSIDE_MARGIN, side, window); + } + else + end_xpos = left_in_end; - int use_overflow = (NILP (w->use_right_overflow) ? 0 : 1); - int elt, end_xpos; - int out_start, in_out_end, in_in_start, white_out_end, white_in_end; - int out_cnt, in_out_cnt, in_in_cnt, white_out_cnt, white_in_cnt; + /* Make sure that the area between the end of the inside margin + glyphs and the whitespace glyphs is cleared. */ + if (idb && (white_in_start - end_xpos > 0)) + { + add_margin_blank (dl, idb, w, end_xpos, white_in_start - end_xpos, + side); + } - struct display_block *odb, *idb; + /* Next add the whitespace margin glyphs which are actually in the + inside margin. */ + if (white_in_cnt) + { + add_margin_runes (dl, idb, white_in_start, white_in_cnt, + GL_WHITESPACE, + side, window); + } - window = wrap_window (w); + /* Whitespace glyphs always end right next to the text block so + there is nothing we have to make sure is cleared after them. */ + } + else + { + /* First add the whitespace margin glyphs which are actually in the + inside margin. */ + if (white_in_cnt) + { + end_xpos = add_margin_runes (dl, idb, dl->bounds.right_white, + white_in_cnt, GL_WHITESPACE, side, + window); + } + else + end_xpos = dl->bounds.right_white; - /* We have to add the glyphs to the line in the order outside, - inside, whitespace. However the precedence dictates that we - determine how many will fit in the reverse order. */ + /* Make sure that the area between the end of the whitespace glyphs + and the inside margin glyphs is cleared. */ + if (in_in_cnt && (in_in_start - end_xpos)) + { + add_margin_blank (dl, idb, w, end_xpos, in_in_start - end_xpos, + side); + } - /* Determine how many whitespace glyphs we can display and where - they should start. */ - white_in_end = dl->bounds.right_white; - white_out_end = dl->bounds.right_in; - white_out_cnt = white_in_cnt = 0; - elt = 0; + /* Next add the inside margin glyphs which are actually in the + inside margin. */ + if (in_in_cnt) + { + end_xpos = add_margin_runes (dl, idb, in_in_start, in_in_cnt, + GL_INSIDE_MARGIN, side, window); + } - while (elt < Dynarr_length (dl->right_glyphs)) - { - struct glyph_block *gb = Dynarr_atp (dl->right_glyphs, elt); + /* If we didn't add any inside margin glyphs then make sure the rest + of the inside margin area gets cleared. */ + if (idb && (dl->bounds.right_in - end_xpos)) + { + add_margin_blank (dl, idb, w, end_xpos, + dl->bounds.right_in - end_xpos, + side); + } - if (NILP (gb->extent)) - ABORT (); /* these should have been handled in add_glyph_rune */ + /* Next add any whitespace glyphs in the outside margin. */ + if (white_out_cnt) + { + end_xpos = add_margin_runes (dl, odb, dl->bounds.right_in, + white_out_cnt, + GL_WHITESPACE, side, window); + } + else + end_xpos = dl->bounds.right_in; - if (extent_end_glyph_layout (XEXTENT (gb->extent)) == GL_WHITESPACE) + /* Next add any inside margin glyphs in the outside margin. */ + if (in_out_cnt) { - int width = glyph_width (gb->glyph, window); + end_xpos = add_margin_runes (dl, odb, end_xpos, in_out_cnt, + GL_INSIDE_MARGIN, side, window); + } - if (white_in_end + width <= dl->bounds.right_in) - { - white_in_cnt++; - white_in_end += width; - gb->width = width; - gb->active = 1; - } - else if (use_overflow - && (white_out_end + width <= dl->bounds.right_out)) - { - white_out_cnt++; - white_out_end += width; - gb->width = width; - gb->active = 1; - } - else - gb->active = 0; + /* There may be space between any whitespace or inside margin glyphs + in the outside margin and the actual outside margin glyphs. */ + if (odb && (out_start - end_xpos)) + { + add_margin_blank (dl, odb, w, end_xpos, out_start - end_xpos, + side); } - elt++; + /* Finally, add the outside margin glyphs. */ + if (out_cnt) + { + add_margin_runes (dl, odb, out_start, out_cnt, GL_OUTSIDE_MARGIN, + side, window); + } } +} - /* Determine how many inside margin glyphs we can display and where - they should start. The inside margin glyphs get whatever space - is left after the whitespace glyphs have been displayed. These - are tricky to calculate since if we decide to use the overflow - area we basically have to start over. So for these we build up a - list of just the inside margin glyphs and manipulate it to - determine the needed info. */ - { - glyph_block_dynarr *ib; - int avail_in, avail_out; - int done = 0; - int marker = 0; - int used_in, used_out; - - elt = 0; - used_in = used_out = 0; - ib = Dynarr_new (glyph_block); - while (elt < Dynarr_length (dl->right_glyphs)) - { - struct glyph_block *gb = Dynarr_atp (dl->right_glyphs, elt); - - if (NILP (gb->extent)) - ABORT (); /* these should have been handled in add_glyph_rune */ - - if (extent_end_glyph_layout (XEXTENT (gb->extent)) == GL_INSIDE_MARGIN) - { - gb->width = glyph_width (gb->glyph, window); - used_in += gb->width; - Dynarr_add (ib, *gb); - } - - elt++; - } - - if (white_out_cnt) - avail_in = 0; - else - avail_in = dl->bounds.right_in - white_in_end; - - if (!use_overflow) - avail_out = 0; - else - avail_out = dl->bounds.right_out - white_out_end; - - marker = 0; - while (!done && marker < Dynarr_length (ib)) - { - int width = Dynarr_atp (ib, marker)->width; - - /* If everything now fits in the available inside margin - space, we're done. */ - if (used_in <= avail_in) - done = 1; - else - { - /* Otherwise see if we have room to move a glyph to the - outside. */ - if (used_out + width <= avail_out) - { - used_out += width; - used_in -= width; - } - else - done = 1; - } - - if (!done) - marker++; - } - - /* At this point we now know that everything from marker on goes in - the inside margin and everything before it goes in the outside - margin. The stuff going into the outside margin is guaranteed - to fit, but we may have to trim some stuff from the inside. */ - - in_in_start = dl->bounds.right_in; - in_out_end = dl->bounds.right_in; - in_out_cnt = in_in_cnt = 0; - - Dynarr_free (ib); - elt = 0; - while (elt < Dynarr_length (dl->right_glyphs)) - { - struct glyph_block *gb = Dynarr_atp (dl->right_glyphs, elt); - - if (NILP (gb->extent)) - ABORT (); /* these should have been handled in add_glyph_rune */ - - if (extent_end_glyph_layout (XEXTENT (gb->extent)) == GL_INSIDE_MARGIN) - { - int width = glyph_width (gb->glyph, window); - - if (used_out) - { - in_out_cnt++; - in_out_end += width; - gb->width = width; - gb->active = 1; - used_out -= width; - } - else if (in_in_start - width >= white_in_end) - { - in_in_cnt++; - in_in_start -= width; - gb->width = width; - gb->active = 1; - } - else - gb->active = 0; - } - - elt++; - } - } - - /* Determine how many outside margin glyphs we can display. They - always start at the right outside margin and can only use the - outside margin space. */ - out_start = dl->bounds.right_out; - out_cnt = 0; - elt = 0; - - while (elt < Dynarr_length (dl->right_glyphs)) - { - struct glyph_block *gb = Dynarr_atp (dl->right_glyphs, elt); - - if (NILP (gb->extent)) - ABORT (); /* these should have been handled in add_glyph_rune */ - - if (extent_end_glyph_layout (XEXTENT (gb->extent)) == GL_OUTSIDE_MARGIN) - { - int width = glyph_width (gb->glyph, window); - - if (out_start - width >= in_out_end) - { - out_cnt++; - out_start -= width; - gb->width = width; - gb->active = 1; - } - else - gb->active = 0; - } - - elt++; - } - - /* Now that we now where everything goes, we add the glyphs as runes - to the appropriate display blocks. */ - if (out_cnt || in_out_cnt || white_out_cnt) - { - odb = get_display_block_from_line (dl, RIGHT_OUTSIDE_MARGIN); - /* #### See comments before odb->start_pos init in - create_left_glyph_block */ - odb->start_pos = dl->bounds.right_in; - odb->end_pos = dl->bounds.right_out; - Dynarr_reset (odb->runes); - } - else - odb = 0; - - if (in_in_cnt || white_in_cnt) - { - idb = get_display_block_from_line (dl, RIGHT_INSIDE_MARGIN); - idb->start_pos = dl->bounds.right_white; - /* #### See comments before odb->start_pos init in - create_left_glyph_block */ - idb->end_pos = dl->bounds.right_in; - Dynarr_reset (idb->runes); - } - else - idb = 0; - - /* First add the whitespace margin glyphs which are actually in the - inside margin. */ - if (white_in_cnt) - { - end_xpos = add_margin_runes (dl, idb, dl->bounds.right_white, - white_in_cnt, GL_WHITESPACE, RIGHT_GLYPHS, - window); - } - else - end_xpos = dl->bounds.right_white; - - /* Make sure that the area between the end of the whitespace glyphs - and the inside margin glyphs is cleared. */ - if (in_in_cnt && (in_in_start - end_xpos)) - { - add_margin_blank (dl, idb, w, end_xpos, in_in_start - end_xpos, - RIGHT_GLYPHS); - } - - /* Next add the inside margin glyphs which are actually in the - inside margin. */ - if (in_in_cnt) - { - end_xpos = add_margin_runes (dl, idb, in_in_start, in_in_cnt, - GL_INSIDE_MARGIN, RIGHT_GLYPHS, window); - } - - /* If we didn't add any inside margin glyphs then make sure the rest - of the inside margin area gets cleared. */ - if (idb && (dl->bounds.right_in - end_xpos)) - { - add_margin_blank (dl, idb, w, end_xpos, dl->bounds.right_in - end_xpos, - RIGHT_GLYPHS); - } - - /* Next add any whitespace glyphs in the outside margin. */ - if (white_out_cnt) - { - end_xpos = add_margin_runes (dl, odb, dl->bounds.right_in, white_out_cnt, - GL_WHITESPACE, RIGHT_GLYPHS, window); - } - else - end_xpos = dl->bounds.right_in; - - /* Next add any inside margin glyphs in the outside margin. */ - if (in_out_cnt) - { - end_xpos = add_margin_runes (dl, odb, end_xpos, in_out_cnt, - GL_INSIDE_MARGIN, RIGHT_GLYPHS, window); - } - - /* There may be space between any whitespace or inside margin glyphs - in the outside margin and the actual outside margin glyphs. */ - if (odb && (out_start - end_xpos)) - { - add_margin_blank (dl, odb, w, end_xpos, out_start - end_xpos, - RIGHT_GLYPHS); - } - - /* Finally, add the outside margin glyphs. */ - if (out_cnt) - { - add_margin_runes (dl, odb, out_start, out_cnt, GL_OUTSIDE_MARGIN, - RIGHT_GLYPHS, window); - } -} -  /***************************************************************************/ /* */ ＠＠ -3819,7 +3934,7 ＠＠ offset = w->modeline_hscroll; generate_fstring_runes (w, &data, 0, 0, -1, format_str, 0, max_pixpos - min_pixpos, findex, type, &offset, - Qnil); + Qnil, Qunbound); if (Dynarr_length (db->runes)) { ＠＠ -4041,7 +4156,8 ＠＠ static Charcount add_glyph_to_fstring_db_runes (pos_data *data, Lisp_Object glyph, Charcount pos, Charcount UNUSED (min_pos), - Charcount max_pos, Lisp_Object extent) + Charcount max_pos, Lisp_Object extent, + Lisp_Object matchspec) { /* This function has been Mule-ized. */ Charcount end; ＠＠ -4058,6 +4174,7 ＠＠ gb.glyph = glyph; gb.extent = extent; + gb.matchspec = matchspec; add_glyph_rune (data, &gb, BEGIN_GLYPHS, 0, 0); pos++; ＠＠ -4085,7 +4202,8 ＠＠ Charcount min_pos, Charcount max_pos, Lisp_Object elt, int depth, int max_pixsize, face_index findex, int type, Charcount *offset, - Lisp_Object cur_ext) + /* See big glyphs.c comment for MATCHSPEC */ + Lisp_Object cur_ext, Lisp_Object matchspec) { /* This function has been Mule-ized. */ /* #### The other losing things in this function are: ＠＠ -4157,7 +4275,8 ＠＠ pos = generate_fstring_runes (w, data, pos, spec_width, max_pos, Vglobal_mode_string, depth, max_pixsize, findex, - type, offset, cur_ext); + type, offset, cur_ext, + Qmodeline); } else if (*this_str == '-') { ＠＠ -4378,7 +4497,8 ＠＠ { pos = generate_fstring_runes (w, data, pos, pos, max_pos, XCAR (elt), depth, max_pixsize, - findex, type, offset, cur_ext); + findex, type, offset, cur_ext, + elt); elt = XCDR (elt); } } ＠＠ -4409,885 +4529,163 ＠＠ XFONT_INSTANCE (font_inst)->ascent); data->dl->descent = max (data->dl->descent, XFONT_INSTANCE (font_inst)-> - descent); - } - else - new_findex = old_findex; - - data->findex = new_findex; - pos = generate_fstring_runes (w, data, pos, pos, max_pos, - XCDR (elt), depth - 1, - max_pixsize, new_findex, type, - offset, car); - data->findex = old_findex; - Dynarr_add (formatted_string_extent_dynarr, ext); - Dynarr_add (formatted_string_extent_start_dynarr, start); - Dynarr_add (formatted_string_extent_end_dynarr, data->bytepos); - } - } - } - else if (GLYPHP (elt)) - { - /* Glyphs are considered as one character with respect to the modeline - horizontal scrolling facility. -- dv */ - if (*offset > 0) - *offset -= 1; - else - pos = add_glyph_to_fstring_db_runes (data, elt, pos, pos, max_pos, - cur_ext); - } - else - { - invalid: - { - char *str = GETTEXT ("*invalid*"); - Charcount size = (Charcount) strlen (str); /* is this ok ?? -- dv */ - - if (size <= *offset) - *offset -= size; - else - { - const Ibyte *tmp_str = - itext_n_addr ((const Ibyte *) str, *offset); - - /* #### NOTE: I don't understand why a tmp_max is not computed and - used here as in the plain string case above. -- dv */ - pos = add_string_to_fstring_db_runes (data, tmp_str, pos, - min_pos, max_pos); - *offset = 0; - } - } - } - - if (min_pos > pos) - { - add_string_to_fstring_db_runes (data, (const Ibyte *) "", pos, - min_pos, -1); - } - - return pos; -} - -/* Update just the modeline. Assumes the desired display structs. If - they do not have a modeline block, it does nothing. */ -static void -regenerate_modeline (struct window *w) -{ - display_line_dynarr *dla = window_display_lines (w, DESIRED_DISP); - - if (!Dynarr_length (dla) || !Dynarr_atp (dla, 0)->modeline) - return; - else - { - generate_modeline (w, Dynarr_atp (dla, 0), DESIRED_DISP); - redisplay_update_line (w, 0, 0, 0); - } -} - -/* Make sure that modeline display line is present in the given - display structs if the window has a modeline and update that - line. Returns true if a modeline was needed. */ -static int -ensure_modeline_generated (struct window *w, int type) -{ - int need_modeline; - - /* minibuffer windows don't have modelines */ - if (MINI_WINDOW_P (w)) - need_modeline = 0; - /* windows which haven't had it turned off do */ - else if (WINDOW_HAS_MODELINE_P (w)) - need_modeline = 1; - /* windows which have it turned off don't have a divider if there is - a horizontal scrollbar */ - else if (window_scrollbar_height (w)) - need_modeline = 0; - /* and in this case there is none */ - else - need_modeline = 1; - - if (need_modeline) - { - display_line_dynarr *dla; - - dla = window_display_lines (w, type); - - /* We don't care if there is a display line which is not - currently a modeline because it is definitely going to become - one if we have gotten to this point. */ - if (Dynarr_length (dla) == 0) - { - if (Dynarr_largest (dla) > 0) - Dynarr_increment (dla); - else - { - struct display_line modeline; - xzero (modeline); - Dynarr_add (dla, modeline); - } - } - - /* If we're adding a new place marker go ahead and generate the - modeline so that it is available for use by - window_modeline_height. */ - generate_modeline (w, Dynarr_atp (dla, 0), type); - } - - return need_modeline; -} - -/* #### Kludge or not a kludge. I tend towards the former. */ -int -real_current_modeline_height (struct window *w) -{ - Fset_marker (w->start[CMOTION_DISP], w->start[CURRENT_DISP], w->buffer); - Fset_marker (w->pointm[CMOTION_DISP], w->pointm[CURRENT_DISP], w->buffer); - - if (ensure_modeline_generated (w, CMOTION_DISP)) - { - display_line_dynarr *dla = window_display_lines (w, CMOTION_DISP); - - if (Dynarr_length (dla)) - { - if (Dynarr_atp (dla, 0)->modeline) - return (Dynarr_atp (dla, 0)->ascent + - Dynarr_atp (dla, 0)->descent); - } - } - return 0; -} - - -/***************************************************************************/ -/* */ -/* displayable string routines */ -/* */ -/***************************************************************************/ - -/* Given a position for a string in a window, ensure that the given - display line DL accurately represents the text on a line starting - at the given position. - - Yes, this is duplicating the code of create_text_block, but it - looked just too hard to change create_text_block to handle strings - *and* buffers. We already make a distinction between the two - elsewhere in the code so I think unifying them would require a - complete MULE rewrite. Besides, the other distinction is that these - functions cover text that the user *cannot edit* so we can remove - everything to do with cursors, minibuffers etc. Eventually the - modeline routines should be modified to use this code as it copes - with many more types of display situation. */ - -static Charbpos -create_string_text_block (struct window *w, Lisp_Object disp_string, - struct display_line *dl, - Charcount start_pos, - prop_block_dynarr **prop, - face_index default_face) -{ - struct frame *f = XFRAME (w->frame); - /* Note that a lot of the buffer controlled stuff has been left in - because you might well want to make use of it (selective display - etc), its just the buffer text that we do not use. However, it - seems to be possible for buffer to be nil sometimes so protect - against this case. */ - struct buffer *b = BUFFERP (w->buffer) ? XBUFFER (w->buffer) : 0; - struct device *d = XDEVICE (f->device); - - /* we're working with these a lot so precalculate them */ - Bytecount slen = XSTRING_LENGTH (disp_string); - Bytecount byte_string_zv = slen; - Bytecount byte_start_pos = string_index_char_to_byte (disp_string, start_pos); - - pos_data data; - - int truncate_win = b ? window_truncation_on (w) : 0; - - /* We're going to ditch selective display for static text, it's an - FSF thing and invisible extents are the way to go here. - Implementing it also relies on a number of buffer-specific - functions that we don't have the luxury of being able to use - here. */ - - /* The variable ctl-arrow allows the user to specify what characters - can actually be displayed and which octal should be used for. - #### This variable should probably have some rethought done to - it. - - #### It would also be really nice if you could specify that - the characters come out in hex instead of in octal. Mule - does that by adding a ctl-hexa variable similar to ctl-arrow, - but that's bogus -- we need a more general solution. I - think you need to extend the concept of display tables - into a more general conversion mechanism. Ideally you - could specify a Lisp function that converts characters, - but this violates the Second Golden Rule and besides would - make things way way way way slow. - - So instead, we extend the display-table concept, which was - historically limited to 256-byte vectors, to one of the - following: - - a) A 256-entry vector, for backward compatibility; - b) char-table, mapping characters to values; - c) range-table, mapping ranges of characters to values; - d) a list of the above. - - The (d) option allows you to specify multiple display tables - instead of just one. Each display table can specify conversions - for some characters and leave others unchanged. The way the - character gets displayed is determined by the first display table - with a binding for that character. This way, you could call a - function `enable-hex-display' that adds a hex display-table to - the list of display tables for the current buffer. - - #### ...not yet implemented... Also, we extend the concept of - "mapping" to include a printf-like spec. Thus you can make all - extended characters show up as hex with a display table like - this: - - #s(range-table data ((256 524288) (format "%x"))) - - Since more than one display table is possible, you have - great flexibility in mapping ranges of characters. */ - Ichar printable_min = b ? (CHAR_OR_CHAR_INTP (b->ctl_arrow) - ? XCHAR_OR_CHAR_INT (b->ctl_arrow) - : ((EQ (b->ctl_arrow, Qt) || EQ (b->ctl_arrow, Qnil)) - ? 255 : 160)) : 255; - - Lisp_Object face_dt, window_dt; - - /* The text display block for this display line. */ - struct display_block *db = get_display_block_from_line (dl, TEXT); - - /* The first time through the main loop we need to force the glyph - data to be updated. */ - int initial = 1; - - /* Apparently the new extent_fragment_update returns an end position - equal to the position passed in if there are no more runs to be - displayed. */ - int no_more_frags = 0; - - dl->used_prop_data = 0; - dl->num_chars = 0; - dl->line_continuation = 0; - - /* set up faces to use for clearing areas, used by - output_display_line */ - dl->default_findex = default_face; - if (default_face) - { - dl->left_margin_findex = default_face; - dl->right_margin_findex = default_face; - } - else - { - dl->left_margin_findex = - get_builtin_face_cache_index (w, Vleft_margin_face); - dl->right_margin_findex = - get_builtin_face_cache_index (w, Vright_margin_face); - } - - xzero (data); - data.ef = extent_fragment_new (disp_string, f); - - /* These values are used by all of the rune addition routines. We add - them to this structure for ease of passing. */ - data.d = d; - data.window = wrap_window (w); - data.db = db; - data.dl = dl; - - data.byte_charpos = byte_start_pos; - data.pixpos = dl->bounds.left_in; - data.last_charset = Qunbound; - data.last_findex = default_face; - data.result_str = Qnil; - data.string = disp_string; - - /* Set the right boundary adjusting it to take into account any end - glyph. Save the width of the end glyph for later use. */ - data.max_pixpos = dl->bounds.right_in; - data.max_pixpos -= data.end_glyph_width; - - data.cursor_type = NO_CURSOR; - data.cursor_x = -1; - - data.start_col = 0; - /* I don't think we want this, string areas should not scroll with - the window - data.start_col = w->hscroll; - data.byte_start_col_enabled = (w->hscroll ? byte_start_pos : 0); - */ - data.byte_start_col_enabled = 0; - data.hscroll_glyph_width_adjust = 0; - - /* We regenerate the line from the very beginning. */ - Dynarr_reset (db->runes); - - /* Why is this less than or equal and not just less than? If the - starting position is already equal to the maximum we can't add - anything else, right? Wrong. We might still have a newline to - add. A newline can use the room allocated for an end glyph since - if we add it we know we aren't going to be adding any end - glyph. */ - - /* #### Chuck -- I think this condition should be while (1). - Otherwise if (e.g.) there is one begin-glyph and one end-glyph - and the begin-glyph ends exactly at the end of the window, the - end-glyph and text might not be displayed. while (1) ensures - that the loop terminates only when either (a) there is - propagation data or (b) the end-of-line or end-of-buffer is hit. - - #### Also I think you need to ensure that the operation - "add begin glyphs; add end glyphs; add text" is atomic and - can't get interrupted in the middle. If you run off the end - of the line during that operation, then you keep accumulating - propagation data until you're done. Otherwise, if the (e.g.) - there's a begin glyph at a particular position and attempting - to display that glyph results in window-end being hit and - propagation data being generated, then the character at that - position won't be displayed. - - #### See also the comment after the end of this loop, below. - */ - while (data.pixpos <= data.max_pixpos) - { - /* #### This check probably should not be necessary. */ - if (data.byte_charpos > byte_string_zv) - { - /* #### urk! More of this lossage! */ - data.byte_charpos--; - goto done; - } - - /* Check for face changes. */ - if (initial || (!no_more_frags && data.byte_charpos == data.ef->end)) - { - Lisp_Object last_glyph = Qnil; - /* Deal with clipped glyphs that we have already displayed. */ - if (*prop && Dynarr_atp (*prop, 0)->type == PROP_GLYPH) - { - last_glyph = Dynarr_atp (*prop, 0)->data.p_glyph.glyph; - Dynarr_free (*prop); - *prop = 0; - } - /* Now compute the face and begin/end-glyph information. */ - data.findex = - /* Remember that the extent-fragment routines deal in - Bytexpos's. */ - extent_fragment_update (w, data.ef, data.byte_charpos, last_glyph); - /* This is somewhat cheesy but the alternative is to - propagate default_face into extent_fragment_update. */ - if (data.findex == DEFAULT_INDEX) - data.findex = default_face; - - get_display_tables (w, data.findex, &face_dt, &window_dt); - - if (data.byte_charpos == data.ef->end) - no_more_frags = 1; - } - initial = 0; - - /* Determine what is next to be displayed. We first handle any - glyphs returned by glyphs_at_charbpos. If there are no glyphs to - display then we determine what to do based on the character at the - current buffer position. */ - - /* If the current position is covered by an invisible extent, do - nothing (except maybe add some ellipses). - - #### The behavior of begin and end-glyphs at the edge of an - invisible extent should be investigated further. This is - fairly low priority though. */ - if (data.ef->invisible) - { - /* #### Chuck, perhaps you could look at this code? I don't - really know what I'm doing. */ - if (*prop) - { - Dynarr_free (*prop); - *prop = 0; - } - - /* The extent fragment code only sets this when we should - really display the ellipses. It makes sure the ellipses - don't get displayed more than once in a row. */ - if (data.ef->invisible_ellipses) - { - struct glyph_block gb; - - data.ef->invisible_ellipses_already_displayed = 1; - data.ef->invisible_ellipses = 0; - gb.extent = Qnil; - gb.glyph = Vinvisible_text_glyph; - *prop = add_glyph_rune (&data, &gb, BEGIN_GLYPHS, 0, - GLYPH_CACHEL (w, INVIS_GLYPH_INDEX)); - /* Perhaps they shouldn't propagate if the very next thing - is to display a newline (for compatibility with - selective-display-ellipses)? Maybe that's too - abstruse. */ - if (*prop) - goto done; - } - - /* #### What if we're dealing with a display table? */ - if (data.start_col) - data.start_col--; - - if (data.byte_charpos == byte_string_zv) - goto done; - else - INC_BYTECOUNT (XSTRING_DATA (disp_string), data.byte_charpos); - } - - /* If there is propagation data, then it represents the current - buffer position being displayed. Add them and advance the - position counter. This might also add the minibuffer - prompt. */ - else if (*prop) - { - dl->used_prop_data = 1; - *prop = add_propagation_runes (prop, &data); - - if (*prop) - goto done; /* gee, a really narrow window */ - else if (data.byte_charpos == byte_string_zv) - goto done; - else if (data.byte_charpos < 0) - /* #### urk urk urk! Aborts are not very fun! Fix this please! */ - data.byte_charpos = 0; - else - INC_BYTECOUNT (XSTRING_DATA (disp_string), data.byte_charpos); - } - - /* If there are end glyphs, add them to the line. These are - the end glyphs for the previous run of text. We add them - here rather than doing them at the end of handling the - previous run so that glyphs at the beginning and end of - a line are handled correctly. */ - else if (Dynarr_length (data.ef->end_glyphs) > 0) - { - data.ch = string_ichar (disp_string, data.byte_charpos); - *prop = add_glyph_runes (&data, END_GLYPHS); - - if (*prop) { - goto done; - } - } - - /* If there are begin glyphs, add them to the line. */ - else if (Dynarr_length (data.ef->begin_glyphs) > 0) - { - data.ch = string_ichar (disp_string, data.byte_charpos); - *prop = add_glyph_runes (&data, BEGIN_GLYPHS); - - if (*prop) { - goto done; - } - } - - /* If at end-of-buffer, we've already processed begin and - end-glyphs at this point and there's no text to process, - so we're done. */ - else if (data.byte_charpos == byte_string_zv) - goto done; - - else - { - Lisp_Object entry = Qnil; - /* Get the character at the current buffer position. */ - data.ch = string_ichar (disp_string, data.byte_charpos); - if (!NILP (face_dt) || !NILP (window_dt)) - entry = display_table_entry (data.ch, face_dt, window_dt); - - /* If there is a display table entry for it, hand it off to - add_disp_table_entry_runes and let it worry about it. */ - if (!NILP (entry) && !EQ (entry, make_char (data.ch))) - { - *prop = add_disp_table_entry_runes (&data, entry); - - if (*prop) - goto done; - } - - /* Check if we have hit a newline character. If so, add a marker - to the line and end this loop. */ - else if (data.ch == '\n') - { - /* We aren't going to be adding an end glyph so give its - space back in order to make sure that the cursor can - fit. */ - data.max_pixpos += data.end_glyph_width; - goto done; - } - - /* If the current character is considered to be printable, then - just add it. */ - else if (data.ch >= printable_min) - { - *prop = add_ichar_rune (&data); - if (*prop) - goto done; - } - - /* If the current character is a tab, determine the next tab - starting position and add a blank rune which extends from the - current pixel position to that starting position. */ - else if (data.ch == '\t') - { - int tab_start_pixpos = data.pixpos; - int next_tab_start; - int char_tab_width; - int prop_width = 0; - - if (data.start_col > 1) - tab_start_pixpos -= (space_width (w) * (data.start_col - 1)); - - next_tab_start = - next_tab_position (w, tab_start_pixpos, - dl->bounds.left_in + - data.hscroll_glyph_width_adjust); - if (next_tab_start > data.max_pixpos) - { - prop_width = next_tab_start - data.max_pixpos; - next_tab_start = data.max_pixpos; - } - data.blank_width = next_tab_start - data.pixpos; - char_tab_width = - (next_tab_start - tab_start_pixpos) / space_width (w); - - *prop = add_blank_rune (&data, w, char_tab_width); - - /* add_blank_rune is only supposed to be called with - sizes guaranteed to fit in the available space. */ - assert (!(*prop)); - - if (prop_width) - { - struct prop_block pb; - *prop = Dynarr_new (prop_block); - - pb.type = PROP_BLANK; - pb.data.p_blank.width = prop_width; - pb.data.p_blank.findex = data.findex; - Dynarr_add (*prop, pb); - - goto done; - } - } - - /* If character is a control character, pass it off to - add_control_char_runes. - - The is_*() routines have undefined results on - arguments outside of the range [-1, 255]. (This - often bites people who carelessly use `char' instead - of `unsigned char'.) - */ - else if (data.ch < 0x100 && iscntrl ((Ibyte) data.ch)) - { - *prop = add_control_char_runes (&data, b); - - if (*prop) - goto done; - } - - /* If the character is above the ASCII range and we have not - already handled it, then print it as an octal number. */ - else if (data.ch >= 0200) - { - *prop = add_octal_runes (&data); - - if (*prop) - goto done; - } - - /* Assume the current character is considered to be printable, - then just add it. */ - else - { - *prop = add_ichar_rune (&data); - if (*prop) - goto done; - } - - INC_BYTECOUNT (XSTRING_DATA (disp_string), data.byte_charpos); - } - } - - done: - - /* Determine the starting point of the next line if we did not hit the - end of the buffer. */ - if (data.byte_charpos < byte_string_zv) - { - /* #### This check is not correct. If the line terminated - due to a begin-glyph or end-glyph hitting window-end, then - data.ch will not point to the character at data.byte_charpos. If - you make the two changes mentioned at the top of this loop, - you should be able to say '(if (*prop))'. That should also - make it possible to eliminate the data.byte_charpos < BYTE_BUF_ZV (b) - check. */ - - /* The common case is that the line ended because we hit a newline. - In that case, the next character is just the next buffer - position. */ - if (data.ch == '\n') - { - INC_BYTECOUNT (XSTRING_DATA (disp_string), data.byte_charpos); - } - - /* Otherwise we have a buffer line which cannot fit on one display - line. */ - else - { - struct glyph_block gb; - struct glyph_cachel *cachel; - - /* If the line is to be truncated then we actually have to look - for the next newline. We also add the end-of-line glyph which - we know will fit because we adjusted the right border before - we starting laying out the line. */ - data.max_pixpos += data.end_glyph_width; - data.findex = default_face; - gb.extent = Qnil; - - if (truncate_win) - { - Bytecount byte_pos; - - /* Now find the start of the next line. */ - byte_pos = byte_find_next_ichar_in_string (disp_string, '\n', - data.byte_charpos, 1); - - data.cursor_type = NO_CURSOR; - data.byte_charpos = byte_pos; - gb.glyph = Vtruncation_glyph; - cachel = GLYPH_CACHEL (w, TRUN_GLYPH_INDEX); - } - else - { - /* The cursor can never be on the continuation glyph. */ - data.cursor_type = NO_CURSOR; - - /* data.byte_charpos is already at the start of the next line. */ - - dl->line_continuation = 1; - gb.glyph = Vcontinuation_glyph; - cachel = GLYPH_CACHEL (w, CONT_GLYPH_INDEX); - } - - if (data.end_glyph_width) - add_glyph_rune (&data, &gb, BEGIN_GLYPHS, 0, cachel); + descent); + } + else + new_findex = old_findex; - if (truncate_win && data.byte_charpos == byte_string_zv) - { - const Ibyte *endb = itext_n_addr (XSTRING_DATA (disp_string), - byte_string_zv); - DEC_IBYTEPTR (endb); - if (itext_ichar (endb) != '\n') - { - /* #### Damn this losing shit. */ - data.byte_charpos++; - } - } - } + data->findex = new_findex; + pos = generate_fstring_runes (w, data, pos, pos, max_pos, + XCDR (elt), depth - 1, + max_pixsize, new_findex, type, + offset, car, elt); + data->findex = old_findex; + Dynarr_add (formatted_string_extent_dynarr, ext); + Dynarr_add (formatted_string_extent_start_dynarr, start); + Dynarr_add (formatted_string_extent_end_dynarr, data->bytepos); + } + } } - else if (data.byte_charpos == byte_string_zv) + else if (GLYPHP (elt)) { - /* create_text_block () adds a bogus \n marker here which screws - up subwindow display. Since we never have a cursor in the - gutter we can safely ignore it. */ + /* Glyphs are considered as one character with respect to the modeline + horizontal scrolling facility. -- dv */ + if (*offset > 0) + *offset -= 1; + else + pos = add_glyph_to_fstring_db_runes (data, elt, pos, pos, max_pos, + cur_ext, matchspec); } - /* Calculate left whitespace boundary. */ - { - int elt = 0; - - /* Whitespace past a newline is considered right whitespace. */ - while (elt < Dynarr_length (db->runes)) + else + { + invalid: { - struct rune *rb = Dynarr_atp (db->runes, elt); + char *str = GETTEXT ("*invalid*"); + Charcount size = (Charcount) strlen (str); /* is this ok ?? -- dv */ - if ((rb->type == RUNE_CHAR && rb->object.chr.ch == ' ') - || rb->type == RUNE_BLANK) - { - dl->bounds.left_white += rb->width; - elt++; - } + if (size <= *offset) + *offset -= size; else - elt = Dynarr_length (db->runes); - } - } - - /* Calculate right whitespace boundary. */ - { - int elt = Dynarr_length (db->runes) - 1; - int done = 0; - - while (!done && elt >= 0) - { - struct rune *rb = Dynarr_atp (db->runes, elt); - - if (!(rb->type == RUNE_CHAR && rb->object.chr.ch < 0x100 - && isspace (rb->object.chr.ch)) - && !rb->type == RUNE_BLANK) { - dl->bounds.right_white = rb->xpos + rb->width; - done = 1; - } - - elt--; + const Ibyte *tmp_str = + itext_n_addr ((const Ibyte *) str, *offset); + /* #### NOTE: I don't understand why a tmp_max is not computed and + used here as in the plain string case above. -- dv */ + pos = add_string_to_fstring_db_runes (data, tmp_str, pos, + min_pos, max_pos); + *offset = 0; + } } - - /* The line is blank so everything is considered to be right - whitespace. */ - if (!done) - dl->bounds.right_white = dl->bounds.left_in; - } + } - /* Set the display blocks bounds. */ - db->start_pos = dl->bounds.left_in; - if (Dynarr_length (db->runes)) + if (min_pos > pos) { - struct rune *rb = Dynarr_atp (db->runes, Dynarr_length (db->runes) - 1); - - db->end_pos = rb->xpos + rb->width; + add_string_to_fstring_db_runes (data, (const Ibyte *) "", pos, + min_pos, -1); } - else - db->end_pos = dl->bounds.right_white; - - calculate_baseline (&data); - dl->ascent = data.new_ascent; - dl->descent = data.new_descent; - - { - unsigned short ascent = (unsigned short) XINT (w->minimum_line_ascent); - - if (dl->ascent < ascent) - dl->ascent = ascent; - } - { - unsigned short descent = (unsigned short) XINT (w->minimum_line_descent); - - if (dl->descent < descent) - dl->descent = descent; - } + return pos; +} - calculate_yoffset (dl, db); +/* Update just the modeline. Assumes the desired display structs. If + they do not have a modeline block, it does nothing. */ +static void +regenerate_modeline (struct window *w) +{ + display_line_dynarr *dla = window_display_lines (w, DESIRED_DISP); - dl->cursor_elt = data.cursor_x; - /* #### lossage lossage lossage! Fix this shit! */ - if (data.byte_charpos > byte_string_zv) - dl->end_charpos = buffer_or_string_bytexpos_to_charxpos (disp_string, - byte_string_zv); - else - dl->end_charpos = - buffer_or_string_bytexpos_to_charxpos (disp_string, - data.byte_charpos) - 1; - if (truncate_win) - data.dl->num_chars = - string_column_at_point (disp_string, dl->end_charpos, - b ? XINT (b->tab_width) : 8); + if (!Dynarr_length (dla) || !Dynarr_atp (dla, 0)->modeline) + return; else - /* This doesn't correctly take into account tabs and control - characters but if the window isn't being truncated then this - value isn't going to end up being used anyhow. */ - data.dl->num_chars = dl->end_charpos - dl->charpos; - - /* #### handle horizontally scrolled line with text none of which - was actually laid out. */ - - /* #### handle any remainder of overlay arrow */ - - if (*prop == ADD_FAILED) - *prop = NULL; - - if (truncate_win && *prop) { - Dynarr_free (*prop); - *prop = NULL; + generate_modeline (w, Dynarr_atp (dla, 0), DESIRED_DISP); + redisplay_update_line (w, 0, 0, 0); } +} - extent_fragment_delete (data.ef); +/* Make sure that modeline display line is present in the given + display structs if the window has a modeline and update that + line. Returns true if a modeline was needed. */ +static int +ensure_modeline_generated (struct window *w, int type) +{ + int need_modeline; - /* #### If we started at EOB, then make sure we return a value past - it so that regenerate_window will exit properly. This is bogus. - The main loop should get fixed so that it isn't necessary to call - this function if we are already at EOB. */ + /* minibuffer windows don't have modelines */ + if (MINI_WINDOW_P (w)) + need_modeline = 0; + /* windows which haven't had it turned off do */ + else if (WINDOW_HAS_MODELINE_P (w)) + need_modeline = 1; + /* windows which have it turned off don't have a divider if there is + a horizontal scrollbar */ + else if (window_scrollbar_height (w)) + need_modeline = 0; + /* and in this case there is none */ + else + need_modeline = 1; - if (data.byte_charpos == byte_string_zv && byte_start_pos == byte_string_zv) - return string_index_byte_to_char (disp_string, - data.byte_charpos) + 1; /* Yuck! */ - else - return string_index_byte_to_char (disp_string, data.byte_charpos); -} - -/* Given a display line and a starting position, ensure that the - contents of the display line accurately represent the visual - representation of the buffer contents starting from the given - position when displayed in the given window. The display line ends - when the contents of the line reach the right boundary of the given - window. - - This is very similar to generate_display_line but with the same - limitations as create_string_text_block. I have taken the liberty - of fixing the bytebpos stuff though.*/ + if (need_modeline) + { + display_line_dynarr *dla; -static Charbpos -generate_string_display_line (struct window *w, Lisp_Object disp_string, - struct display_line *dl, - Charcount start_pos, - prop_block_dynarr **prop, - face_index default_face) -{ - Charcount ret_charcount; + dla = window_display_lines (w, type); - /* you must set bounds before calling this. */ + /* We don't care if there is a display line which is not + currently a modeline because it is definitely going to become + one if we have gotten to this point. */ + if (Dynarr_length (dla) == 0) + { + if (Dynarr_largest (dla) > 0) + Dynarr_increment (dla); + else + { + struct display_line modeline; + xzero (modeline); + Dynarr_add (dla, modeline); + } + } - /* Reset what this line is using. */ - if (dl->display_blocks) - Dynarr_reset (dl->display_blocks); - if (dl->left_glyphs) - { - Dynarr_free (dl->left_glyphs); - dl->left_glyphs = 0; - } - if (dl->right_glyphs) - { - Dynarr_free (dl->right_glyphs); - dl->right_glyphs = 0; + /* If we're adding a new place marker go ahead and generate the + modeline so that it is available for use by + window_modeline_height. */ + generate_modeline (w, Dynarr_atp (dla, 0), type); } - /* We aren't generating a modeline at the moment. */ - dl->modeline = 0; - - /* Create a display block for the text region of the line. */ - ret_charcount = create_string_text_block (w, disp_string, dl, start_pos, - prop, default_face); - dl->charpos = start_pos; - if (dl->end_charpos < dl->charpos) - dl->end_charpos = dl->charpos; + return need_modeline; +} - /* If there are left glyphs associated with any character in the - text block, then create a display block to handle them. */ - if (dl->left_glyphs != NULL && Dynarr_length (dl->left_glyphs)) - create_left_glyph_block (w, dl, 0); +/* #### Kludge or not a kludge. I tend towards the former. */ +int +real_current_modeline_height (struct window *w) +{ + Fset_marker (w->start[CMOTION_DISP], w->start[CURRENT_DISP], w->buffer); + Fset_marker (w->pointm[CMOTION_DISP], w->pointm[CURRENT_DISP], w->buffer); - /* If there are right glyphs associated with any character in the - text block, then create a display block to handle them. */ - if (dl->right_glyphs != NULL && Dynarr_length (dl->right_glyphs)) - create_right_glyph_block (w, dl); + if (ensure_modeline_generated (w, CMOTION_DISP)) + { + display_line_dynarr *dla = window_display_lines (w, CMOTION_DISP); - return ret_charcount; + if (Dynarr_length (dla)) + { + if (Dynarr_atp (dla, 0)->modeline) + return (Dynarr_atp (dla, 0)->ascent + + Dynarr_atp (dla, 0)->descent); + } + } + return 0; } -/* + +/***************************************************************************/ +/* */ +/* displayable string routines */ +/* */ +/***************************************************************************/ -Info on Re-entrancy crashes, with backtraces given: +/* + Info on Re-entrancy crashes, with backtraces given: (Info-goto-node "(internals)Nasty Bugs due to Reentrancy in Redisplay Structures handling QUIT") */ ＠＠ -5295,11 +4693,18 ＠＠ /* This is ripped off from regenerate_window. All we want to do is loop through elements in the string creating display lines until we - have covered the provided area. Simple really. */ + have covered the provided area. Simple really. + + NOTE: This is the only remaining non-unified function. Formerly there + were duplicated and nearly identical versions of create_text_block() and + generate_display_line(). This function is somewhat different from + regenerate_window(), and not too much logic is duplicated, so I'm + leaving it as is for the moment. --ben */ + void generate_displayable_area (struct window *w, Lisp_Object disp_string, int xpos, int ypos, int width, int height, - display_line_dynarr* dla, + display_line_dynarr *dla, Charcount start_pos, face_index default_face) { ＠＠ -5318,7 +4723,7 ＠＠ if (!in_display) depth = enter_redisplay_critical_section (); - assert (dla); + display_checking_assert (dla); Dynarr_reset (dla); s_zv = string_char_length (disp_string); ＠＠ -5358,8 +4763,9 ＠＠ dlp->bounds = bounds; dlp->offset = 0; Dynarr_lock (dla); - next_pos = generate_string_display_line (w, disp_string, dlp, start_pos, - &prop, default_face); + next_pos = generate_display_line (w, dlp, 1, start_pos, &prop, + disp_string, default_face, + DESIRED_DISP); Dynarr_unlock (dla); /* we need to make sure that we continue along the line if there is more left to display otherwise we just end up redisplaying ＠＠ -5526,7 +4932,8 ＠＠ dlp->bounds = bounds; dlp->offset = 0; Dynarr_lock (dla); - start_pos = generate_display_line (w, dlp, 1, start_pos, &prop, type); + start_pos = generate_display_line (w, dlp, 1, start_pos, &prop, Qnil, + DEFAULT_INDEX, type); Dynarr_unlock (dla); if (yclip > dlp->ascent) ＠＠ -5813,7 +5220,8 ＠＠ return 0; generate_display_line (w, ddl, 0, ddl->charpos + ddl->offset, - &prop, DESIRED_DISP); + &prop, Qnil, DEFAULT_INDEX, + DESIRED_DISP); ddl->offset = 0; /* #### If there is propagated stuff the fail. We could ＠＠ -5964,7 +5372,8 ＠＠ return 0; generate_display_line (w, ddl, 0, ddl->charpos + ddl->offset, - &prop, DESIRED_DISP); + &prop, Qnil, DEFAULT_INDEX, + DESIRED_DISP); ddl->offset = 0; /* If there is propagated stuff then it is pretty much a ＠＠ -6366,8 +5775,8 ＠＠ && !f->extents_changed && !f->faces_changed && !f->glyphs_changed - && !f->subwindows_changed - /* && !f->subwindows_state_changed*/ + && !f->subcontrols_changed + /* && !f->subcontrols_state_changed*/ && !f->point_changed && !f->windows_structure_changed) { ＠＠ -6388,8 +5797,8 ＠＠ && !f->extents_changed && !f->faces_changed && !f->glyphs_changed - && !f->subwindows_changed - /* && !f->subwindows_state_changed*/ + && !f->subcontrols_changed + /* && !f->subcontrols_state_changed*/ && !f->windows_structure_changed) { if (point_visible (w, pointm, CURRENT_DISP) ＠＠ -6431,7 +5840,7 ＠＠ up with a blank window. */ else if (((w->start_at_line_beg || MINI_WINDOW_P (w)) && !(startp == BUF_BEGV (b) - || BUF_FETCH_CHAR (b, startp - 1) == '\n')) + || BUF_ICHAR_AT (b, startp - 1) == '\n')) || (pointm == startp && EQ (Fmarker_buffer (w->last_start[CURRENT_DISP]), w->buffer) && startp < marker_position (w->last_start[CURRENT_DISP])) ＠＠ -6447,8 +5856,8 ＠＠ && !f->clip_changed && !f->faces_changed && !f->glyphs_changed - && !f->subwindows_changed - /* && !f->subwindows_state_changed*/ + && !f->subcontrols_changed + /* && !f->subcontrols_state_changed*/ && !f->windows_structure_changed && !f->frame_changed && !truncation_changed ＠＠ -6893,16 +6302,16 ＠＠ if (f->clear) f->frame_changed = 1; - /* Invalidate the subwindow caches. We use subwindows_changed here - to cause subwindows to get instantiated. This is because - subwindows_state_changed is less strict - dealing with things - like the clicked state of button. We have to do this before - redisplaying the gutters as subwindows get unmapped in the - process.*/ + /* Invalidate the subcontrol caches. We use subcontrols_changed here + ^^#### but we don't -- we use frame_changed. to cause subcontrols to + get instantiated. This is because subcontrols_state_changed is less + strict - dealing with things like the clicked state of button. We have + to do this before redisplaying the gutters as subcontrols get unmapped + in the process.*/ if (f->frame_changed) - reset_frame_subwindow_instance_cache (f); + frame_unmap_all_subcontrols (f); - if (f->frame_changed || f->subwindows_changed) + if (f->frame_changed || f->subcontrols_changed) { /* we have to do this so the gutter gets regenerated. */ reset_gutter_display_lines (f); ＠＠ -7249,7 +6658,9 ＠＠ Charbpos pt = (w == XWINDOW (Fselected_window (Qnil))) ? BUF_PT (b) : marker_position (w->pointm[type]); - int col = column_at_point (b, pt, 1) + !!column_number_start_at_one; + int col = (column_at_point (wrap_buffer (b), pt, XINT (b->tab_width), + 1) + + !!column_number_start_at_one); char buf[DECIMAL_PRINT_SIZE (long)]; long_to_string (buf, col); ＠＠ -7291,7 +6702,7 ＠＠ if (FRAME_TTY_P (f) && f->order_count > 1 && f->order_count <= 99999999) { /* Naughty, naughty */ - char * writable_str = alloca_array (char, 10); + char *writable_str = alloca_array (char, 10); sprintf (writable_str, "-%d", f->order_count); str = writable_str; } ＠＠ -7586,6 +6997,8 ＠＠ mark_object (gb->glyph); if (!NILP (gb->extent)) mark_object (gb->extent); + if (!NILP (gb->matchspec) && !UNBOUNDP (gb->matchspec)) + mark_object (gb->matchspec); } } } ＠＠ -7618,6 +7031,9 ＠＠ mark_object (r->object.dglyph.glyph); if (!NILP (r->object.dglyph.extent)) mark_object (r->object.dglyph.extent); + if (!NILP (r->object.dglyph.matchspec) && + !UNBOUNDP (r->object.dglyph.matchspec)) + mark_object (r->object.dglyph.matchspec); } } } ＠＠ -8749,6 +8165,7 ＠＠ OBJ2 is one of -- an extent, if the coordinates are over a glyph in the text area + (or maybe modeline) -- nil otherwise. If the coordinates are over a glyph, OBJ_X and OBJ_Y give the ＠＠ -9591,15 +9008,15 ＠＠ } void -mark_subwindows_changed (void) +mark_subcontrols_changed (void) { - MARK_TYPE_CHANGED (subwindows); + MARK_TYPE_CHANGED (subcontrols); } void -mark_subwindows_state_changed (void) +mark_subcontrols_state_changed (void) { - MARK_TYPE_CHANGED (subwindows_state); + MARK_TYPE_CHANGED (subcontrols_state); } #ifdef MEMORY_USAGE_STATS ＠＠ -9990,11 +9407,10 ＠＠ *Non-nil means column display number starts at 1. */ ); column_number_start_at_one = 0; -} -void -specifier_vars_of_redisplay (void) -{ + + /* specifiers */ + DEFVAR_SPECIFIER ("left-margin-width", &Vleft_margin_width /* *Width of left margin. This is a specifier; use `set-specifier' to change it. 1.22.4.1 +152 -61 XEmacs/xemacs/src/redisplay.h Index: redisplay.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/redisplay.h,v retrieving revision 1.22 retrieving revision 1.22.4.1 diff -u -r1.22 -r1.22.4.1 --- redisplay.h 2005/01/26 10:33:42 1.22 +++ redisplay.h 2005/02/16 00:43:50 1.22.4.1 ＠＠ -61,13 +61,15 ＠＠ /* The possible types of runes. - #### The Lisp_Glyph type is broken. There should instead be a pixmap + [[ #### The Lisp_Glyph type is broken. There should instead be a pixmap type. Currently the device-specific output routines have to worry about whether the glyph is textual or not, etc. For Mule this is a big problem because you might need multiple fonts to display the text. It also eliminates optimizations that could come from glumping the text of multiple text glyphs together -- this makes displaying - binary files (with lots of control chars, etc.) very very slow. */ + binary files (with lots of control chars, etc.) very very slow. ]] + This appears fixed now. The code in add_glyph_rune() checks for a text + glyph and generates character runes instead. --ben */ #define RUNE_BLANK 0 #define RUNE_CHAR 1 ＠＠ -104,7 +106,14 ＠＠ Lisp_Object extent; /* extent rune is attached to, if any. If this is a rune in the modeline then this might be nil. */ - + Lisp_Object matchspec;/* governing object of glyph; see glyphs.c. #### + The only reason we need this is to support + subcontrols in the modeline! It's not clear it + should be wasting space in each rune. #### In + fact, we should be using a separate Dynarr to + store all rune info for glyphs, and just include + a pointer here. That would make runes a whole + lot smaller. */ int ascent; /* Ascent of this glyph, in pixels. */ int descent; /* Descent of this glyph, in pixels. */ int yoffset; /* Offset from line top to reach glyph top */ ＠＠ -133,11 +142,27 ＠＠ for the modeline, the value here is a Charcount, but who's looking? */ Charxpos endpos; /* if set this rune covers a range of pos; - used in redisplay_move_cursor(). */ - /* #### Chuck, what does it mean for a rune - to cover a range of pos? I don't get - this. */ - + used in redisplay_move_cursor(). #### + Seriously underused and should not be + wasting space here. Appears to be used + only for hscroll glyph runes, where the + display is horizontally scrolled to the + right and where the hscroll rune + "logically" represents the characters + between the logical beginning of the + display line (which should always be the + actual line beginning, as far as I know, + in this case) and the first character + actually displayed. charpos gets set to + the beginning of this span and endpos to + the end. ENDPOS is only ever used in + redisplay_move_cursor(); #### shouldn't + we just special-case this in that + function and retrieve the start-of-line + from the display-line structure? #### + We should move this into the dglyph + structure and move the dglyph structure + out of this structure. */ short xpos; /* horizontal starting position in pixels */ short width; /* pixel width of rune */ ＠＠ -153,8 +178,10 ＠＠ union /* Information specific to the type of rune */ { - /* #### Glyphs are rare. Is it really necessary to waste 8 bytes on every - rune for that?! */ + /* #### Glyphs are rare. Is it really necessary to waste so many bytes + on every rune for that?! Clearly not. Make a separate Dynarr to + store all rune info for glyphs, and just include a pointer here. + That would make runes a whole lot smaller. */ /* DGLYPH */ struct rune_dglyph dglyph; ＠＠ -244,12 +271,28 ＠＠ { Lisp_Object glyph; Lisp_Object extent; + /* Used as the governing object for a glyph, to ensure that different + subcontrols being displayed have unique image instances even if the same + glyph is used twice in the same buffer. Qunbound means we have no + suitable governing object (e.g. for a built-in glyph, such as the + continuation glyph), so make sure we get an error for subcontrols. + Otherwise, an extent or cons (for a modeline glyph). + */ + Lisp_Object matchspec; /* The rest are only used by margin routines. */ face_index findex; int active; int width; }; +DECLARE_INLINE_HEADER ( +Lisp_Object +glyph_block_matchspec (struct glyph_block *gb) +) +{ + return gb->matchspec; +} + typedef struct { Dynarr_declare (glyph_block); ＠＠ -258,8 +301,48 ＠＠ /*************************************************************************/ /* display lines */ /*************************************************************************/ + +/* The redisplay structures look like this: -/* Modeline commentary: IMO the modeline is handled very badly, we + -- Each frame contains a tree of windows. There is a corresponding tree + of "window mirrors". It seems that the purpose of window mirrors is + to handle changes to the window structure -- given that redisplay + works by keeping two sets of data (current and desired), it wants to + know what's currently on the screen even if the user has changed the + window structure. The window mirror structure serves as "current", + and the actual window structure as "desired". (#### This could be + wrong. Document window mirrors properly.) + + -- Each window mirror contains two arrays of display lines: + + display_line_dynarr *current_display_lines; + display_line_dynarr *desired_display_lines; + + Redisplay updates the desired lines, then compares with the current + to determine what to update, then copies desired into current. + + -- Each struct display_line describes a single line, which is logically + broken up into struct display_blocks, one for each different portion + of the line (the main or "text" portion, inside left and right margins, + outside left and right margins, and the "overlay arrow"). See + enum display_type. (It appears that the outside margins are the + specially reserved sections that can be displayed by setting e.g. + `left-margin-width', while the inside margins overwrite text at the + left or right edges. #### Not sure about this.) The blocks will only + be present if there is something in that block. The first block, if + present, is always the text block. + + -- Each struct display_block contains an array of runes, each of which + represents a single displayed character or a single glyph. (In the + case of text glyphs, multiple runes are generated, one per character, + instead of a single text glyph. [This happens in add_glyph_rune().] + This is how it should be -- the device- specific routines don't have + to worry about text glyphs themselves, and display is much faster + because the characters are glumped together into a single call to the + window system.) + */ + +/* #### Modeline commentary: IMO the modeline is handled very badly, we special case virtually *everything* in the redisplay routines for the modeline. The fact that dl->charpos can be either a buffer position or a char count highlights this. There is no abstraction at ＠＠ -299,7 +382,21 ＠＠ in pixels.*/ Charxpos charpos; /* first buffer position on line */ Charxpos end_charpos; /* last buffer position on line */ - Charcount offset; /* adjustment to charpos vals */ + Charcount offset; /* adjustment to charpos vals. + it appears to be used to handle + "incremental line updating", where + the text has been inserted and + deleted and affects only a single + line, so to speed things up, rather + than recalculating everything, we + redisplay just this line and change + the offset values on the lines + below so that things like + pixel_to_glyph_translation(), which + require correct charpos values, still + work. #### i wonder if this + optimization is even being triggered + properly. */ Charcount num_chars; /* # of chars on line including expansion of tabs and control chars */ ＠＠ -315,10 +412,19 ＠＠ char line_continuation; /* t if this line continues to next display line. */ - /* Dynamic array of display blocks */ + /* Dynamic array of display blocks, one for each different type listed in + enum display_type -- i.e. there will be at most 6 items in this array. + The first one is always TEXT. See comment above. */ display_block_dynarr *display_blocks; - /* Dynamic arrays of left and right glyph blocks */ + /* Dynamic arrays of left and right glyph blocks. It appears that the + purpose of this is to accumulate the glyphs that are attached to + extents and ought to be in the left or right margin. As we lay out + the text part of a display line (i.e. minus the left or right + margins), we may encounter extents with glyphs that belong in the + margins. We accumulate them in these structures, and then later (in + create_left_or_right_glyph_block()) go back and store the ones that + fit into the appropriate display block. */ glyph_block_dynarr *left_glyphs; glyph_block_dynarr *right_glyphs; ＠＠ -448,15 +554,15 ＠＠ extern int glyphs_changed; extern int glyphs_changed_set; -/* True if any displayed subwindow is in need of updating +/* True if any displayed subcontrol is in need of updating somewhere. */ -extern int subwindows_changed; -extern int subwindows_changed_set; +extern int subcontrols_changed; +extern int subcontrols_changed_set; -/* True if any displayed subwindow is in need of updating +/* True if any displayed subcontrol is in need of updating somewhere. */ -extern int subwindows_state_changed; -extern int subwindows_state_changed_set; +extern int subcontrols_state_changed; +extern int subcontrols_state_changed_set; /* True if an icon is in need of updating somewhere. */ extern int icon_changed; ＠＠ -544,10 +650,10 ＠＠ #define MARK_GUTTER_CHANGED mark_gutter_changed () void mark_glyphs_changed (void); #define MARK_GLYPHS_CHANGED mark_glyphs_changed () -void mark_subwindows_changed (void); -#define MARK_SUBWINDOWS_CHANGED mark_subwindows_changed () -void mark_subwindows_state_changed (void); -#define MARK_SUBWINDOWS_STATE_CHANGED mark_subwindows_state_changed () +void mark_subcontrols_changed (void); +#define MARK_SUBCONTROLS_CHANGED mark_subcontrols_changed () +void mark_subcontrols_state_changed (void); +#define MARK_SUBCONTROLS_STATE_CHANGED mark_subcontrols_state_changed () #define CLASS_RESET_CHANGED_FLAGS(p) do { \ (p)->buffers_changed = 0; \ ＠＠ -563,8 +669,8 ＠＠ (p)->toolbar_changed = 0; \ (p)->gutter_changed = 0; \ (p)->glyphs_changed = 0; \ - (p)->subwindows_changed = 0; \ - (p)->subwindows_state_changed = 0; \ + (p)->subcontrols_changed = 0; \ + (p)->subcontrols_state_changed = 0; \ (p)->windows_changed = 0; \ (p)->windows_structure_changed = 0; \ } while (0) ＠＠ -582,8 +688,8 ＠＠ toolbar_changed = 0; \ gutter_changed = 0; \ glyphs_changed = 0; \ - subwindows_changed = 0; \ - subwindows_state_changed = 0; \ + subcontrols_changed = 0; \ + subcontrols_state_changed = 0; \ windows_changed = 0; \ windows_structure_changed = 0; \ } while (0) ＠＠ -603,8 +709,8 ＠＠ (p)->gutter_changed || \ (p)->glyphs_changed || \ (p)->size_changed || \ - (p)->subwindows_changed || \ - (p)->subwindows_state_changed || \ + (p)->subcontrols_changed || \ + (p)->subcontrols_state_changed || \ (p)->windows_changed || \ (p)->windows_structure_changed ) ＠＠ -623,8 +729,8 ＠＠ gutter_changed || \ glyphs_changed || \ size_changed || \ - subwindows_changed || \ - subwindows_state_changed || \ + subcontrols_changed || \ + subcontrols_state_changed || \ windows_changed || \ windows_structure_changed ) ＠＠ -642,8 +748,8 ＠＠ toolbar_changed_set = 0; \ gutter_changed_set = 0; \ glyphs_changed_set = 0; \ - subwindows_changed_set = 0; \ - subwindows_state_changed_set = 0; \ + subcontrols_changed_set = 0; \ + subcontrols_state_changed_set = 0; \ } while (0)  ＠＠ -736,7 +842,7 ＠＠ void mark_redisplay_structs (display_line_dynarr *dla); void generate_displayable_area (struct window *w, Lisp_Object disp_string, int xpos, int ypos, int width, int height, - display_line_dynarr* dl, + display_line_dynarr *dl, Charbpos start_pos, face_index default_face); /* `generate_title_string' in frame.c needs this */ void generate_formatted_string_db (Lisp_Object format_str, ＠＠ -782,35 +888,21 ＠＠ int get_next_display_block (layout_bounds bounds, display_block_dynarr *dba, int start_pos, int *next_start); -void redisplay_output_layout (Lisp_Object domain, - Lisp_Object image_instance, - struct display_box* db, - struct display_glyph_area* dga, - face_index findex, int cursor_start, - int cursor_width, - int cursor_height); -void redisplay_output_subwindow (struct window *w, - Lisp_Object image_instance, - struct display_box* db, - struct display_glyph_area* dga, - face_index findex, int cursor_start, - int cursor_width, - int cursor_height); -void redisplay_unmap_subwindows_maybe (struct frame* f, int x, int y, - int width, int height); +void redisplay_unmap_subcontrols (struct frame *f, int x, int y, + int width, int height, + Lisp_Object ignored_subcontrol); +void redisplay_output_window (struct window *w); void redisplay_output_pixmap (struct window *w, Lisp_Object image_instance, - struct display_box* db, - struct display_glyph_area* dga, - face_index findex, int cursor_start, - int cursor_width, - int cursor_height, int offset_bitmap); + struct display_box *db, + struct display_glyph_area *dga, + face_index findex, int offset_bitmap); int redisplay_calculate_display_boxes (struct display_line *dl, int xpos, int xoffset, int yoffset, int start_pixpos, - int width, struct display_box* dest, - struct display_glyph_area* src); -int redisplay_normalize_glyph_area (struct display_box* dest, - struct display_glyph_area* glyphsrc); + int width, struct display_box *dest, + struct display_glyph_area *src); +int redisplay_normalize_glyph_area (struct display_box *dest, + struct display_glyph_area *glyphsrc); void redisplay_clear_to_window_end (struct window *w, int ypos1, int ypos2); void redisplay_clear_region (Lisp_Object window, face_index findex, int x, int y, int width, int height); ＠＠ -820,7 +912,6 ＠＠ int min_start, int max_end); void redisplay_update_line (struct window *w, int first_line, int last_line, int update_values); -void redisplay_output_window (struct window *w); void bevel_modeline (struct window *w, struct display_line *dl); int redisplay_move_cursor (struct window *w, Charbpos new_point, int no_output_end); 1.16.4.1 +39 -39 XEmacs/xemacs/src/scrollbar-gtk.c Index: scrollbar-gtk.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/scrollbar-gtk.c,v retrieving revision 1.16 retrieving revision 1.16.4.1 diff -u -r1.16 -r1.16.4.1 --- scrollbar-gtk.c 2005/01/24 23:34:09 1.16 +++ scrollbar-gtk.c 2005/02/16 00:43:50 1.16.4.1 ＠＠ -23,6 +23,9 ＠＠ /* Synched up with: Not in FSF. */ /* Gtk version by William M. Perry */ +/* Reviewed 2-13-05 for duplicated code by Ben Wing. scrollbar_loop() and + the three small functions that call it are nearly identical to the code + in scrollbar-x.c. But this is only about 100 lines total. */ #include <config.h> #include "lisp.h" ＠＠ -296,18 +299,18 ＠＠ } } -enum gtk_scrollbar_loop +enum scrollbar_loop { - GTK_FIND_SCROLLBAR_WINDOW_MIRROR, - GTK_SET_SCROLLBAR_POINTER, - GTK_WINDOW_IS_SCROLLBAR, - GTK_UPDATE_FRAME_SCROLLBARS + FIND_SCROLLBAR_WINDOW_MIRROR, + SET_SCROLLBAR_POINTER, + WINDOW_IS_SCROLLBAR, + UPDATE_FRAME_SCROLLBARS }; static struct window_mirror * -gtk_scrollbar_loop (enum gtk_scrollbar_loop type, Lisp_Object window, - struct window_mirror *mir, - GUI_ID id, GdkWindow *x_win) +scrollbar_loop (enum scrollbar_loop type, Lisp_Object window, + struct window_mirror *mir, + GUI_ID id, GdkWindow *win) { struct window_mirror *retval = NULL; ＠＠ -318,9 +321,9 ＠＠ struct window *w = XWINDOW (window); if (mir->vchild) - retval = gtk_scrollbar_loop (type, w->vchild, mir->vchild, id, x_win); + retval = scrollbar_loop (type, w->vchild, mir->vchild, id, win); else if (mir->hchild) - retval = gtk_scrollbar_loop (type, w->hchild, mir->hchild, id, x_win); + retval = scrollbar_loop (type, w->hchild, mir->hchild, id, win); if (retval) return retval; ＠＠ -328,16 +331,16 ＠＠ { switch (type) { - case GTK_FIND_SCROLLBAR_WINDOW_MIRROR: + case FIND_SCROLLBAR_WINDOW_MIRROR: if ((vinstance && SCROLLBAR_GTK_ID (vinstance) == id) || (hinstance && SCROLLBAR_GTK_ID (hinstance) == id)) return mir; break; - case GTK_UPDATE_FRAME_SCROLLBARS: + case UPDATE_FRAME_SCROLLBARS: if (!mir->vchild && !mir->hchild) update_window_scrollbars (w, mir, 1, 0); break; - case GTK_SET_SCROLLBAR_POINTER: + case SET_SCROLLBAR_POINTER: if (!mir->vchild && !mir->hchild) { GtkWidget *widget; ＠＠ -351,19 +354,19 ＠＠ update_one_widget_scrollbar_pointer (w, widget); } break; - case GTK_WINDOW_IS_SCROLLBAR: + case WINDOW_IS_SCROLLBAR: if (!mir->vchild && !mir->hchild) { GtkWidget *widget; widget = SCROLLBAR_GTK_WIDGET (hinstance); if (widget && GTK_WIDGET_MAPPED (widget) && - GET_GTK_WIDGET_WINDOW (widget) == x_win) + GET_GTK_WIDGET_WINDOW (widget) == win) return (struct window_mirror *) 1; widget = SCROLLBAR_GTK_WIDGET (vinstance); if (widget && GTK_WIDGET_MAPPED (widget) && - GET_GTK_WIDGET_WINDOW (widget) == x_win) + GET_GTK_WIDGET_WINDOW (widget) == win) return (struct window_mirror *) 1; } break; ＠＠ -385,9 +388,9 ＠＠ { if (f->mirror_dirty) update_frame_window_mirror (f); - return gtk_scrollbar_loop (GTK_FIND_SCROLLBAR_WINDOW_MIRROR, f->root_window, - XWINDOW_MIRROR (f->root_mirror), id, - (GdkWindow *) NULL); + return scrollbar_loop (FIND_SCROLLBAR_WINDOW_MIRROR, f->root_window, + XWINDOW_MIRROR (f->root_mirror), id, + (GdkWindow *) NULL); } static gboolean ＠＠ -400,8 +403,8 ＠＠ GUI_ID id = (GUI_ID) gtk_object_get_data (GTK_OBJECT (adj), GTK_DATA_GUI_IDENTIFIER); Lisp_Object win, frame; struct window_mirror *mirror; - Lisp_Object event_type = Qnil; - Lisp_Object event_data = Qnil; + enum scrollbar_event_type event_type = -1; + Lisp_Object value = Qnil; if (!f) return(FALSE); ＠＠ -414,39 +417,36 ＠＠ if (NILP (win)) return(FALSE); - instance = vertical ? mirror->scrollbar_vertical_instance : mirror->scrollbar_horizontal_instance; - frame = WINDOW_FRAME (XWINDOW (win)); + instance = vertical ? mirror->scrollbar_vertical_instance : + mirror->scrollbar_horizontal_instance; inhibit_slider_size_change = 0; switch (GTK_RANGE (SCROLLBAR_GTK_WIDGET (instance))->scroll_type) { case GTK_SCROLL_PAGE_BACKWARD: - event_type = vertical ? Qscrollbar_page_up : Qscrollbar_page_left; - event_data = Fcons (win, Qnil); + event_type = vertical ? SCROLLBAR_PAGE_UP : SCROLLBAR_PAGE_LEFT; break; case GTK_SCROLL_PAGE_FORWARD: - event_type = vertical ? Qscrollbar_page_down : Qscrollbar_page_right; - event_data = Fcons (win, Qnil); + event_type = vertical ? SCROLLBAR_PAGE_DOWN : SCROLLBAR_PAGE_RIGHT; break; case GTK_SCROLL_STEP_FORWARD: - event_type = vertical ? Qscrollbar_line_down : Qscrollbar_char_right; - event_data = win; + event_type = vertical ? SCROLLBAR_LINE_DOWN : SCROLLBAR_CHAR_RIGHT; break; case GTK_SCROLL_STEP_BACKWARD: - event_type = vertical ? Qscrollbar_line_up : Qscrollbar_char_left; - event_data = win; + event_type = vertical ? SCROLLBAR_LINE_UP : SCROLLBAR_CHAR_LEFT; break; case GTK_SCROLL_NONE: case GTK_SCROLL_JUMP: inhibit_slider_size_change = 1; - event_type = vertical ? Qscrollbar_vertical_drag : Qscrollbar_horizontal_drag; - event_data = Fcons (win, make_int ((int)adj->value)); + event_type = vertical ? SCROLLBAR_VERTICAL_DRAG : + SCROLLBAR_HORIZONTAL_DRAG; + value = make_int ((int) adj->value); break; default: ABORT(); } - signal_special_gtk_user_event (frame, event_type, event_data); + enqueue_scrollbar_event (event_type, win, value); return (TRUE); } ＠＠ -456,8 +456,8 ＠＠ { Lisp_Object window = wrap_window (w); - gtk_scrollbar_loop (GTK_SET_SCROLLBAR_POINTER, window, - find_window_mirror (w), 0, (GdkWindow *) NULL); + scrollbar_loop (SET_SCROLLBAR_POINTER, window, + find_window_mirror (w), 0, (GdkWindow *) NULL); } /* #### BILL!!! This comment is not true for Gtk - should it be? */ ＠＠ -466,9 +466,9 ＠＠ void gtk_update_frame_scrollbars (struct frame *f) { - gtk_scrollbar_loop (GTK_UPDATE_FRAME_SCROLLBARS, f->root_window, - XWINDOW_MIRROR (f->root_mirror), - 0, (GdkWindow *) NULL); + scrollbar_loop (UPDATE_FRAME_SCROLLBARS, f->root_window, + XWINDOW_MIRROR (f->root_mirror), + 0, (GdkWindow *) NULL); } #ifdef MEMORY_USAGE_STATS 1.28.6.1 +23 -28 XEmacs/xemacs/src/scrollbar-msw.c Index: scrollbar-msw.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/scrollbar-msw.c,v retrieving revision 1.28 retrieving revision 1.28.6.1 diff -u -r1.28 -r1.28.6.1 --- scrollbar-msw.c 2004/09/20 19:19:58 1.28 +++ scrollbar-msw.c 2005/02/16 00:43:51 1.28.6.1 ＠＠ -208,6 +208,8 ＠＠ SCROLLINFO scrollinfo; int vert = qxeGetWindowLong (hwnd, GWL_STYLE) & SBS_VERT; int value; + enum scrollbar_event_type event_type = (enum scrollbar_event_type) -1; + Lisp_Object lispval = Qnil; v = (void *) qxeGetWindowLong (hwnd, GWL_USERDATA); if (!v) ＠＠ -248,36 +250,27 ＠＠ switch (code) { case SB_LINEDOWN: - mswindows_enqueue_misc_user_event - (frame, vert ? Qscrollbar_line_down : Qscrollbar_char_right, win); + event_type = vert ? SCROLLBAR_LINE_DOWN : SCROLLBAR_CHAR_RIGHT; break; case SB_LINEUP: - mswindows_enqueue_misc_user_event - (frame, vert ? Qscrollbar_line_up : Qscrollbar_char_left, win); + event_type = vert ? SCROLLBAR_LINE_UP : SCROLLBAR_CHAR_LEFT; break; case SB_PAGEDOWN: - mswindows_enqueue_misc_user_event - (win, vert ? Qscrollbar_page_down : Qscrollbar_page_right, - vert ? Fcons (win, Qnil) : win); + event_type = vert ? SCROLLBAR_PAGE_DOWN : SCROLLBAR_PAGE_RIGHT; break; case SB_PAGEUP: - mswindows_enqueue_misc_user_event - (frame, - vert ? Qscrollbar_page_up : Qscrollbar_page_left, - vert ? Fcons (win, Qnil) : win); + event_type = vert ? SCROLLBAR_PAGE_UP : SCROLLBAR_PAGE_LEFT; break; case SB_BOTTOM: - mswindows_enqueue_misc_user_event - (frame, vert ? Qscrollbar_to_bottom : Qscrollbar_to_right, win); + event_type = vert ? SCROLLBAR_TO_BOTTOM : SCROLLBAR_TO_RIGHT; break; case SB_TOP: - mswindows_enqueue_misc_user_event - (frame, vert ? Qscrollbar_to_top : Qscrollbar_to_left, win); + event_type = vert ? SCROLLBAR_TO_TOP : SCROLLBAR_TO_LEFT; break; case SB_THUMBTRACK: ＠＠ -303,12 +296,11 ＠＠ else #endif value = scrollinfo.nTrackPos; - mswindows_enqueue_misc_user_event - (frame, - vert ? Qscrollbar_vertical_drag : Qscrollbar_horizontal_drag, - Fcons (win, make_int (value))); + event_type = vert ? SCROLLBAR_VERTICAL_DRAG : SCROLLBAR_HORIZONTAL_DRAG; + lispval = make_int (value); break; + case SB_ENDSCROLL: #ifdef VERTICAL_SCROLLBAR_DRAG_HACK if (vertical_drag_in_progress && sb) ＠＠ -319,6 +311,9 ＠＠ vertical_drag_in_progress = 0; break; } + + if (event_type >= 0) + enqueue_scrollbar_event (event_type, win, lispval); } static int ＠＠ -392,12 +387,12 ＠＠ if (wheelScrollLines == WHEEL_PAGESCROLL) { /* Scroll by a page */ - Lisp_Object function; + enum scrollbar_event_type type; if (hasVertBar) - function = delta > 0 ? Qscrollbar_page_up : Qscrollbar_page_down; + type = delta > 0 ? SCROLLBAR_PAGE_UP : SCROLLBAR_PAGE_DOWN; else - function = delta > 0 ? Qscrollbar_page_left : Qscrollbar_page_right; - mswindows_enqueue_misc_user_event (frame, function, Fcons (win, Qnil)); + type = delta > 0 ? SCROLLBAR_PAGE_LEFT : SCROLLBAR_PAGE_RIGHT; + enqueue_scrollbar_event (type, win, Qnil); } else /* Scroll by a number of lines */ { ＠＠ -405,15 +400,15 ＠＠ int toScroll = MulDiv (delta, wheelScrollLines, WHEEL_DELTA); /* Do the scroll */ - Lisp_Object function; + enum scrollbar_event_type type; if (hasVertBar) - function = delta > 0 ? Qscrollbar_line_up : Qscrollbar_line_down; + type = delta > 0 ? SCROLLBAR_LINE_UP : SCROLLBAR_LINE_DOWN; else - function = delta > 0 ? Qscrollbar_char_left : Qscrollbar_char_right; + type = delta > 0 ? SCROLLBAR_CHAR_LEFT : SCROLLBAR_CHAR_RIGHT; if (toScroll < 0) toScroll = -toScroll; while (toScroll--) - mswindows_enqueue_misc_user_event (frame, function, win); + enqueue_scrollbar_event (type, win, Qnil); } return TRUE; ＠＠ -495,5 +490,5 ＠＠ staticpro (&Vmswindows_scrollbar_instance_table); Vmswindows_scrollbar_instance_table = - make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (100, hash_table_non_weak, HASH_TABLE_EQ); } 1.28.4.1 +66 -68 XEmacs/xemacs/src/scrollbar-x.c Index: scrollbar-x.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/scrollbar-x.c,v retrieving revision 1.28 retrieving revision 1.28.4.1 diff -u -r1.28 -r1.28.4.1 --- scrollbar-x.c 2005/01/24 23:34:09 1.28 +++ scrollbar-x.c 2005/02/16 00:43:51 1.28.4.1 ＠＠ -3,6 +3,7 ＠＠ Copyright (C) 1994 Amdahl Corporation. Copyright (C) 1995 Sun Microsystems, Inc. Copyright (C) 1995 Darrell Kindred <dkindred+(a)cmu.edu&gt;. + Copyright (C) 2002 Ben Wing. This file is part of XEmacs. ＠＠ -29,6 +30,7 ＠＠ #include "lisp.h" #include "device-impl.h" +#include "events.h" #include "frame-impl.h" #include "window.h" ＠＠ -295,19 +297,21 ＠＠ } } -enum x_scrollbar_loop +enum scrollbar_loop { - X_FIND_SCROLLBAR_WINDOW_MIRROR, - X_SET_SCROLLBAR_POINTER, - X_WINDOW_IS_SCROLLBAR, - X_UPDATE_FRAME_SCROLLBARS + FIND_SCROLLBAR_WINDOW_MIRROR, + SET_SCROLLBAR_POINTER, + WINDOW_IS_SCROLLBAR, + UPDATE_FRAME_SCROLLBARS }; static struct window_mirror * -x_scrollbar_loop (enum x_scrollbar_loop type, Lisp_Object window, - struct window_mirror *mir, - LWLIB_ID id, Window x_win) +scrollbar_loop (enum scrollbar_loop type, Lisp_Object window, + struct window_mirror *mir, + LWLIB_ID id, Window win) { + /* DUPLICATION NOTE: This function is duplicated in scrollbar-gtk.c. + Changes must be propagated. */ struct window_mirror *retval = NULL; while (mir) ＠＠ -317,9 +321,9 ＠＠ struct window *w = XWINDOW (window); if (mir->vchild) - retval = x_scrollbar_loop (type, w->vchild, mir->vchild, id, x_win); + retval = scrollbar_loop (type, w->vchild, mir->vchild, id, win); else if (mir->hchild) - retval = x_scrollbar_loop (type, w->hchild, mir->hchild, id, x_win); + retval = scrollbar_loop (type, w->hchild, mir->hchild, id, win); if (retval) return retval; ＠＠ -327,16 +331,16 ＠＠ { switch (type) { - case X_FIND_SCROLLBAR_WINDOW_MIRROR: + case FIND_SCROLLBAR_WINDOW_MIRROR: if ((vinstance && SCROLLBAR_X_ID (vinstance) == id) || (hinstance && SCROLLBAR_X_ID (hinstance) == id)) return mir; break; - case X_UPDATE_FRAME_SCROLLBARS: + case UPDATE_FRAME_SCROLLBARS: if (!mir->vchild && !mir->hchild) update_window_scrollbars (w, mir, 1, 0); break; - case X_SET_SCROLLBAR_POINTER: + case SET_SCROLLBAR_POINTER: if (!mir->vchild && !mir->hchild) { Widget widget; ＠＠ -350,19 +354,19 ＠＠ update_one_widget_scrollbar_pointer (w, widget); } break; - case X_WINDOW_IS_SCROLLBAR: + case WINDOW_IS_SCROLLBAR: if (!mir->vchild && !mir->hchild) { Widget widget; widget = SCROLLBAR_X_WIDGET (hinstance); if (widget && XtIsManaged (widget) && - XtWindow (widget) == x_win) + XtWindow (widget) == win) return (struct window_mirror *) 1; widget = SCROLLBAR_X_WIDGET (vinstance); if (widget && XtIsManaged (widget) && - XtWindow (widget) == x_win) + XtWindow (widget) == win) return (struct window_mirror *) 1; } break; ＠＠ -384,8 +388,8 ＠＠ { if (f->mirror_dirty) update_frame_window_mirror (f); - return x_scrollbar_loop (X_FIND_SCROLLBAR_WINDOW_MIRROR, f->root_window, - XWINDOW_MIRROR (f->root_mirror), id, (Window) NULL); + return scrollbar_loop (FIND_SCROLLBAR_WINDOW_MIRROR, f->root_window, + XWINDOW_MIRROR (f->root_mirror), id, (Window) NULL); } /* ＠＠ -419,24 +423,24 ＠＠ instance = mirror->scrollbar_vertical_instance; frame = WINDOW_FRAME (XWINDOW (win)); - /* It seems that this is necessary whenever signal_special_Xt_user_event() + /* It seems that this is necessary whenever enqueue_Xt_dispatch_event() is called. #### Why??? */ DEVICE_X_MOUSE_TIMESTAMP (d) = DEVICE_X_GLOBAL_MOUSE_TIMESTAMP (d); switch (data->action) { - case SCROLLBAR_LINE_UP: - signal_special_Xt_user_event (frame, Qscrollbar_line_up, win); + case LW_SCROLLBAR_LINE_UP: + enqueue_scrollbar_event (SCROLLBAR_LINE_UP, win, Qnil); break; - case SCROLLBAR_LINE_DOWN: - signal_special_Xt_user_event (frame, Qscrollbar_line_down, win); + case LW_SCROLLBAR_LINE_DOWN: + enqueue_scrollbar_event (SCROLLBAR_LINE_DOWN, win, Qnil); break; /* The Athena scrollbar paging behavior is that of xterms. Depending on where you click the size of the page varies. Motif always does a standard Emacs page. */ - case SCROLLBAR_PAGE_UP: + case LW_SCROLLBAR_PAGE_UP: #if !defined (LWLIB_SCROLLBARS_MOTIF) && !defined (LWLIB_SCROLLBARS_LUCID) && \ !defined (LWLIB_SCROLLBARS_ATHENA3D) { ＠＠ -447,16 +451,15 ＠＠ if (line > -1.0) line = -1.0; - signal_special_Xt_user_event (frame, Qscrollbar_page_up, - Fcons (win, make_int ((int) line))); + enqueue_scrollbar_event (SCROLLBAR_PAGE_UP, win, + make_int ((int) line)); } #else - signal_special_Xt_user_event (frame, Qscrollbar_page_up, - Fcons (win, Qnil)); + enqueue_scrollbar_event (SCROLLBAR_PAGE_UP, win, Qnil); #endif break; - case SCROLLBAR_PAGE_DOWN: + case LW_SCROLLBAR_PAGE_DOWN: #if !defined (LWLIB_SCROLLBARS_MOTIF) && !defined (LWLIB_SCROLLBARS_LUCID) && \ !defined (LWLIB_SCROLLBARS_ATHENA3D) { ＠＠ -470,27 +473,25 ＠＠ { if (line < 1.0) line = 1.0; - signal_special_Xt_user_event (frame, Qscrollbar_page_down, - Fcons (win, - make_int ((int) line))); + enqueue_scrollbar_event (SCROLLBAR_PAGE_DOWN, win, + make_int ((int) line)); } } #else - signal_special_Xt_user_event (frame, Qscrollbar_page_down, - Fcons (win, Qnil)); + enqueue_scrollbar_event (SCROLLBAR_PAGE_DOWN, win, Qnil); #endif break; - case SCROLLBAR_TOP: - signal_special_Xt_user_event (frame, Qscrollbar_to_top, win); + case LW_SCROLLBAR_TOP: + enqueue_scrollbar_event (SCROLLBAR_TO_TOP, win, Qnil); break; - case SCROLLBAR_BOTTOM: - signal_special_Xt_user_event (frame, Qscrollbar_to_bottom, win); + case LW_SCROLLBAR_BOTTOM: + enqueue_scrollbar_event (SCROLLBAR_TO_BOTTOM, win, Qnil); break; - case SCROLLBAR_CHANGE: + case LW_SCROLLBAR_CHANGE: inhibit_slider_size_change = 0; #if defined (LWLIB_SCROLLBARS_MOTIF) || defined (LWLIB_SCROLLBARS_LUCID) vertical_drag_in_progress = 0; ＠＠ -502,7 +503,7 ＠＠ #endif break; - case SCROLLBAR_DRAG: + case LW_SCROLLBAR_DRAG: { int value; ＠＠ -588,8 +589,8 ＠＠ if (value < SCROLLBAR_X_POS_DATA (instance).minimum) value = SCROLLBAR_X_POS_DATA (instance).minimum; - signal_special_Xt_user_event (frame, Qscrollbar_vertical_drag, - Fcons (win, make_int (value))); + enqueue_scrollbar_event (SCROLLBAR_VERTICAL_DRAG, win, + make_int (value)); } break; ＠＠ -624,46 +625,43 ＠＠ return; frame = WINDOW_FRAME (XWINDOW (win)); - /* It seems that this is necessary whenever signal_special_Xt_user_event() + /* It seems that this is necessary whenever enqueue_Xt_dispatch_event() is called. #### Why??? */ DEVICE_X_MOUSE_TIMESTAMP (d) = DEVICE_X_GLOBAL_MOUSE_TIMESTAMP (d); switch (data->action) { - case SCROLLBAR_LINE_UP: - signal_special_Xt_user_event (frame, Qscrollbar_char_left, win); + case LW_SCROLLBAR_LINE_UP: + enqueue_scrollbar_event (SCROLLBAR_CHAR_LEFT, win, Qnil); break; - case SCROLLBAR_LINE_DOWN: - signal_special_Xt_user_event (frame, Qscrollbar_char_right, win); + case LW_SCROLLBAR_LINE_DOWN: + enqueue_scrollbar_event (SCROLLBAR_CHAR_RIGHT, win, Qnil); break; - case SCROLLBAR_PAGE_UP: - signal_special_Xt_user_event (frame, Qscrollbar_page_left, win); + case LW_SCROLLBAR_PAGE_UP: + enqueue_scrollbar_event (SCROLLBAR_PAGE_LEFT, win, Qnil); break; - case SCROLLBAR_PAGE_DOWN: - signal_special_Xt_user_event (frame, Qscrollbar_page_right, win); + case LW_SCROLLBAR_PAGE_DOWN: + enqueue_scrollbar_event (SCROLLBAR_PAGE_RIGHT, win, Qnil); break; - case SCROLLBAR_TOP: - signal_special_Xt_user_event (frame, Qscrollbar_to_left, win); + case LW_SCROLLBAR_TOP: + enqueue_scrollbar_event (SCROLLBAR_TO_LEFT, win, Qnil); break; - case SCROLLBAR_BOTTOM: - signal_special_Xt_user_event (frame, Qscrollbar_to_right, win); + case LW_SCROLLBAR_BOTTOM: + enqueue_scrollbar_event (SCROLLBAR_TO_RIGHT, win, Qnil); break; - case SCROLLBAR_CHANGE: + case LW_SCROLLBAR_CHANGE: inhibit_slider_size_change = 0; break; - case SCROLLBAR_DRAG: + case LW_SCROLLBAR_DRAG: inhibit_slider_size_change = 1; /* #### Fix the damn toolkit code so they all work the same way. Lucid is the one mostly wrong.*/ #if defined (LWLIB_SCROLLBARS_LUCID) || defined (LWLIB_SCROLLBARS_ATHENA3D) - signal_special_Xt_user_event (frame, Qscrollbar_horizontal_drag, - (Fcons - (win, make_int (data->slider_value)))); + enqueue_scrollbar_event (SCROLLBAR_HORIZONTAL_DRAG, win, + make_int (data->slider_value)); #else - signal_special_Xt_user_event (frame, Qscrollbar_horizontal_drag, - (Fcons - (win, - make_int (data->slider_value - 1)))); + enqueue_scrollbar_event (SCROLLBAR_HORIZONTAL_DRAG, win, + make_int (data->slider_value - 1)); #endif break; default: ＠＠ -676,8 +674,8 ＠＠ { Lisp_Object window = wrap_window (w); - x_scrollbar_loop (X_SET_SCROLLBAR_POINTER, window, find_window_mirror (w), - 0, (Window) NULL); + scrollbar_loop (SET_SCROLLBAR_POINTER, window, find_window_mirror (w), + 0, (Window) NULL); } /* Make sure that all scrollbars on frame are up-to-date. Called ＠＠ -685,8 +683,8 ＠＠ void x_update_frame_scrollbars (struct frame *f) { - x_scrollbar_loop (X_UPDATE_FRAME_SCROLLBARS, f->root_window, - XWINDOW_MIRROR (f->root_mirror), 0, (Window) NULL); + scrollbar_loop (UPDATE_FRAME_SCROLLBARS, f->root_window, + XWINDOW_MIRROR (f->root_mirror), 0, (Window) NULL); } #ifdef MEMORY_USAGE_STATS 1.33.4.1 +14 -320 XEmacs/xemacs/src/scrollbar.c Index: scrollbar.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/scrollbar.c,v retrieving revision 1.33 retrieving revision 1.33.4.1 diff -u -r1.33 -r1.33.4.1 --- scrollbar.c 2005/01/06 03:45:32 1.33 +++ scrollbar.c 2005/02/16 00:43:51 1.33.4.1 ＠＠ -3,7 +3,7 ＠＠ Copyright (C) 1995 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. Copyright (C) 1995 Darrell Kindred <dkindred+(a)cmu.edu&gt;. - Copyright (C) 2003 Ben Wing. + Copyright (C) 2002, 2003, 2005 Ben Wing. This file is part of XEmacs. ＠＠ -40,22 +40,6 ＠＠ Lisp_Object Qinit_scrollbar_from_resources; -Lisp_Object Qscrollbar_line_up; -Lisp_Object Qscrollbar_line_down; -Lisp_Object Qscrollbar_page_up; -Lisp_Object Qscrollbar_page_down; -Lisp_Object Qscrollbar_to_top; -Lisp_Object Qscrollbar_to_bottom; -Lisp_Object Qscrollbar_vertical_drag; - -Lisp_Object Qscrollbar_char_left; -Lisp_Object Qscrollbar_char_right; -Lisp_Object Qscrollbar_page_left; -Lisp_Object Qscrollbar_page_right; -Lisp_Object Qscrollbar_to_left; -Lisp_Object Qscrollbar_to_right; -Lisp_Object Qscrollbar_horizontal_drag; - #define DEFAULT_SCROLLBAR_WIDTH 15 #define DEFAULT_SCROLLBAR_HEIGHT 15 ＠＠ -382,11 +366,10 ＠＠ /* * If w->sb_point is on the top line then return w->sb_point else - * return w->start. If flag, then return beginning point of line - * which w->sb_point lies on. + * return w->start. */ static Charbpos -scrollbar_point (struct window *w, int flag) +scrollbar_point (struct window *w) { Charbpos start_pos, end_pos, sb_pos; Lisp_Object buf; ＠＠ -398,7 +381,7 ＠＠ start_pos = marker_position (w->start[CURRENT_DISP]); sb_pos = marker_position (w->sb_point); - if (!flag && sb_pos < start_pos) + if (sb_pos < start_pos) return start_pos; buf = get_buffer (w->buffer, 0); ＠＠ -407,14 +390,9 ＠＠ else return start_pos; - if (flag) - end_pos = find_next_newline_no_quit (b, sb_pos, -1); - else - end_pos = find_next_newline_no_quit (b, start_pos, 1); + end_pos = find_next_newline_no_quit (b, start_pos, 1); - if (flag) - return end_pos; - else if (sb_pos > end_pos) + if (sb_pos > end_pos) return start_pos; else return sb_pos; ＠＠ -443,7 +421,7 ＠＠ #endif end_pos = BUF_Z (b) - w->window_end_pos[CURRENT_DISP]; - sb_pos = scrollbar_point (w, 0); + sb_pos = scrollbar_point (w); start_pos = sb_pos; /* The end position must be strictly greater than the start ＠＠ -656,270 +634,16 ＠＠ if (f->init_finished) MAYBE_FRAMEMETH (f, scrollbar_pointer_changed_in_window, (w)); } - -/* #### - - All of the following stuff is functions that handle scrollbar - actions. All of it should be moved into Lisp. This may require - adding some badly-needed primitives. */ - -/********** vertical scrollbar stuff **********/ - -/* - * If the original point is still visible, put the cursor back there. - * Otherwise, when scrolling down stick it at the beginning of the - * first visible line and when scrolling up stick it at the beginning - * of the last visible line. - */ - -/* #### This function should be moved into Lisp */ -static void -scrollbar_reset_cursor (Lisp_Object win, Lisp_Object orig_pt) -{ - /* When this function is called we know that start is already - accurate. We know this because either set-window-start or - recenter was called immediately prior to it being called. */ - Lisp_Object buf; - Charbpos start_pos = XINT (Fwindow_start (win)); - Charbpos ptint = XINT (orig_pt); - struct window *w = XWINDOW (win); - int selected = ((w == XWINDOW (Fselected_window (XFRAME (w->frame)->device))) - ? 1 - : 0); - - buf = Fwindow_buffer (win); - if (NILP (buf)) - return; /* the window was deleted out from under us */ - - if (ptint < XINT (Fwindow_start (win))) - { - if (selected) - Fgoto_char (make_int (start_pos), buf); - else - Fset_window_point (win, make_int (start_pos)); - } - else if (!point_would_be_visible (XWINDOW (win), start_pos, ptint, 0)) - { - Fmove_to_window_line (make_int (-1), win); - - if (selected) - Fbeginning_of_line (Qnil, buf); - else - { - /* #### Taken from forward-line. */ - Charbpos pos; - - pos = find_next_newline (XBUFFER (buf), - marker_position (w->pointm[CURRENT_DISP]), - -1); - Fset_window_point (win, make_int (pos)); - } - } - else - { - if (selected) - Fgoto_char (orig_pt, buf); - else - Fset_window_point (win, orig_pt); - } -} - -DEFUN ("scrollbar-line-up", Fscrollbar_line_up, 1, 1, 0, /* -Function called when the line-up arrow on the scrollbar is clicked. -This is the little arrow at the top of the scrollbar. One argument, the -scrollbar's window. You can advise this function to change the scrollbar -behavior. -*/ - (window)) -{ - CHECK_LIVE_WINDOW (window); - window_scroll (window, make_int (1), -1, ERROR_ME_NOT); - zmacs_region_stays = 1; - return Qnil; -} -DEFUN ("scrollbar-line-down", Fscrollbar_line_down, 1, 1, 0, /* -Function called when the line-down arrow on the scrollbar is clicked. -This is the little arrow at the bottom of the scrollbar. One argument, the -scrollbar's window. You can advise this function to change the scrollbar -behavior. +DEFUN ("window-scrollbar-point-marker", Fwindow_scrollbar_point_marker, + 1, 1, 0, /* +Return marker used internally to control scrollbar position. */ (window)) { - CHECK_LIVE_WINDOW (window); - window_scroll (window, make_int (1), 1, ERROR_ME_NOT); - zmacs_region_stays = 1; - return Qnil; -} - -DEFUN ("scrollbar-page-up", Fscrollbar_page_up, 1, 1, 0, /* -Function called when the user gives the "page-up" scrollbar action. -\(The way this is done can vary from scrollbar to scrollbar.) One argument, -a cons containing the scrollbar's window and a value (#### document me! -This value is nil for Motif/Lucid scrollbars and a number for Athena -scrollbars). You can advise this function to change the scrollbar -behavior. -*/ - (object)) -{ - Lisp_Object window = Fcar (object); - - CHECK_LIVE_WINDOW (window); - /* Motif and Athena scrollbars behave differently, but in accordance - with their standard behaviors. It is not possible to hide the - differences down in lwlib because knowledge of XEmacs buffer and - cursor motion routines is necessary. */ - - if (NILP (XCDR (object))) - window_scroll (window, Qnil, -1, ERROR_ME_NOT); - else - { - Charbpos charbpos; - Lisp_Object value = Fcdr (object); - - CHECK_INT (value); - Fmove_to_window_line (Qzero, window); - /* can't use Fvertical_motion() because it moves the buffer point - rather than the window's point. - - #### It does? Why does it take a window argument then? */ - charbpos = vmotion (XWINDOW (window), XINT (Fwindow_point (window)), - XINT (value), 0); - Fset_window_point (window, make_int (charbpos)); - Fcenter_to_window_line (Qzero, window); - } - - zmacs_region_stays = 1; - return Qnil; + return decode_window (window)->sb_point; } -DEFUN ("scrollbar-page-down", Fscrollbar_page_down, 1, 1, 0, /* -Function called when the user gives the "page-down" scrollbar action. -\(The way this is done can vary from scrollbar to scrollbar.) One argument, -a cons containing the scrollbar's window and a value (#### document me! -This value is nil for Motif/Lucid scrollbars and a number for Athena -scrollbars). You can advise this function to change the scrollbar -behavior. -*/ - (object)) -{ - Lisp_Object window = Fcar (object); - - CHECK_LIVE_WINDOW (window); - /* Motif and Athena scrollbars behave differently, but in accordance - with their standard behaviors. It is not possible to hide the - differences down in lwlib because knowledge of XEmacs buffer and - cursor motion routines is necessary. */ - - if (NILP (XCDR (object))) - window_scroll (window, Qnil, 1, ERROR_ME_NOT); - else - { - Lisp_Object value = Fcdr (object); - CHECK_INT (value); - Fmove_to_window_line (value, window); - Fcenter_to_window_line (Qzero, window); - } - - zmacs_region_stays = 1; - return Qnil; -} - -DEFUN ("scrollbar-to-top", Fscrollbar_to_top, 1, 1, 0, /* -Function called when the user invokes the "to-top" scrollbar action. -The way this is done can vary from scrollbar to scrollbar, but -C-button1 on the up-arrow is very common. One argument, the -scrollbar's window. You can advise this function to change the -scrollbar behavior. -*/ - (window)) -{ - Lisp_Object orig_pt = Fwindow_point (window); - Fset_window_point (window, Fpoint_min (Fwindow_buffer (window))); - Fcenter_to_window_line (Qzero, window); - scrollbar_reset_cursor (window, orig_pt); - zmacs_region_stays = 1; - return Qnil; -} - -DEFUN ("scrollbar-to-bottom", Fscrollbar_to_bottom, 1, 1, 0, /* -Function called when the user invokes the "to-bottom" scrollbar action. -The way this is done can vary from scrollbar to scrollbar, but -C-button1 on the down-arrow is very common. One argument, the -scrollbar's window. You can advise this function to change the -scrollbar behavior. -*/ - (window)) -{ - Lisp_Object orig_pt = Fwindow_point (window); - Fset_window_point (window, Fpoint_max (Fwindow_buffer (window))); - Fcenter_to_window_line (make_int (-3), window); - scrollbar_reset_cursor (window, orig_pt); - zmacs_region_stays = 1; - return Qnil; -} - -DEFUN ("scrollbar-vertical-drag", Fscrollbar_vertical_drag, 1, 1, 0, /* -Function called when the user drags the vertical scrollbar slider. -One argument, a cons containing the scrollbar's window and a value -between point-min and point-max. You can advise this function to -change the scrollbar behavior. -*/ - (object)) -{ - Charbpos start_pos; - Lisp_Object orig_pt; - Lisp_Object window = Fcar (object); - Lisp_Object value = Fcdr (object); - - orig_pt = Fwindow_point (window); - Fset_marker (XWINDOW (window)->sb_point, value, Fwindow_buffer (window)); - start_pos = scrollbar_point (XWINDOW (window), 1); - Fset_window_start (window, make_int (start_pos), Qnil); - scrollbar_reset_cursor (window, orig_pt); - Fsit_for(Qzero, Qnil); - zmacs_region_stays = 1; - return Qnil; -} - -DEFUN ("scrollbar-set-hscroll", Fscrollbar_set_hscroll, 2, 2, 0, /* -Set WINDOW's hscroll position to VALUE. -This ensures that VALUE is in the proper range for the horizontal scrollbar. -*/ - (window, value)) -{ - struct window *w; - int hscroll, wcw, max_len; - - CHECK_LIVE_WINDOW (window); - if (!EQ (value, Qmax)) - CHECK_INT (value); - - w = XWINDOW (window); - wcw = window_char_width (w, 0) - 1; - /* #### We should be able to scroll further right as long as there is - a visible truncation glyph. This calculation for max is bogus. */ - max_len = w->max_line_len + 2; - - if (EQ (value, Qmax) || (XINT (value) > (max_len - wcw))) - hscroll = max_len - wcw; - else - hscroll = XINT (value); - - /* Can't allow this out of set-window-hscroll's acceptable range. */ - /* #### What hell on the earth this code limits scroll size to the - machine-dependent SHORT size? -- kkm */ - if (hscroll < 0) - hscroll = 0; - else if (hscroll >= (1 << (SHORTBITS - 1)) - 1) - hscroll = (1 << (SHORTBITS - 1)) - 1; - - if (hscroll != w->hscroll) - Fset_window_hscroll (window, make_int (hscroll)); - - return Qnil; -} -  /************************************************************************/ /* initialization */ ＠＠ -930,35 +654,9 ＠＠ { INIT_LRECORD_IMPLEMENTATION (scrollbar_instance); - DEFSYMBOL (Qscrollbar_line_up); - DEFSYMBOL (Qscrollbar_line_down); - DEFSYMBOL (Qscrollbar_page_up); - DEFSYMBOL (Qscrollbar_page_down); - DEFSYMBOL (Qscrollbar_to_top); - DEFSYMBOL (Qscrollbar_to_bottom); - DEFSYMBOL (Qscrollbar_vertical_drag); - - DEFSYMBOL (Qscrollbar_char_left); - DEFSYMBOL (Qscrollbar_char_right); - DEFSYMBOL (Qscrollbar_page_left); - DEFSYMBOL (Qscrollbar_page_right); - DEFSYMBOL (Qscrollbar_to_left); - DEFSYMBOL (Qscrollbar_to_right); - DEFSYMBOL (Qscrollbar_horizontal_drag); - DEFSYMBOL (Qinit_scrollbar_from_resources); - - /* #### All these functions should be moved into Lisp. - See comment above. */ - DEFSUBR (Fscrollbar_line_up); - DEFSUBR (Fscrollbar_line_down); - DEFSUBR (Fscrollbar_page_up); - DEFSUBR (Fscrollbar_page_down); - DEFSUBR (Fscrollbar_to_top); - DEFSUBR (Fscrollbar_to_bottom); - DEFSUBR (Fscrollbar_vertical_drag); - DEFSUBR (Fscrollbar_set_hscroll); + DEFSUBR (Fwindow_scrollbar_point_marker); } void ＠＠ -971,12 +669,6 ＠＠ default pointer is used. */ ); - Fprovide (intern ("scrollbar")); -} - -void -specifier_vars_of_scrollbar (void) -{ DEFVAR_SPECIFIER ("scrollbar-width", &Vscrollbar_width /* *Width of vertical scrollbars. This is a specifier; use `set-specifier' to change it. ＠＠ -1085,6 +777,8 ＠＠ some_window_value_changed, offsetof (struct frame, scrollbar_on_top_p), frame_size_slipped, 0); + + Fprovide (intern ("scrollbar")); } void 1.5.12.1 +0 -16 XEmacs/xemacs/src/scrollbar.h Index: scrollbar.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/scrollbar.h,v retrieving revision 1.5 retrieving revision 1.5.12.1 diff -u -r1.5 -r1.5.12.1 --- scrollbar.h 2002/03/29 04:48:32 1.5 +++ scrollbar.h 2005/02/16 00:43:52 1.5.12.1 ＠＠ -72,22 +72,6 ＠＠ extern Lisp_Object Vscrollbar_width, Vscrollbar_height; -extern Lisp_Object Qscrollbar_line_up; -extern Lisp_Object Qscrollbar_line_down; -extern Lisp_Object Qscrollbar_page_up; -extern Lisp_Object Qscrollbar_page_down; -extern Lisp_Object Qscrollbar_to_top; -extern Lisp_Object Qscrollbar_to_bottom; -extern Lisp_Object Qscrollbar_vertical_drag; - -extern Lisp_Object Qscrollbar_char_left; -extern Lisp_Object Qscrollbar_char_right; -extern Lisp_Object Qscrollbar_page_left; -extern Lisp_Object Qscrollbar_page_right; -extern Lisp_Object Qscrollbar_to_left; -extern Lisp_Object Qscrollbar_to_right; -extern Lisp_Object Qscrollbar_horizontal_drag; - #endif /* HAVE_SCROLLBARS */ #endif /* INCLUDED_scrollbar_h_ */ 1.46.4.1 +35 -27 XEmacs/xemacs/src/search.c Index: search.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/search.c,v retrieving revision 1.46 retrieving revision 1.46.4.1 diff -u -r1.46 -r1.46.4.1 --- search.c 2005/01/24 23:34:09 1.46 +++ search.c 2005/02/16 00:43:52 1.46.4.1 ＠＠ -664,7 +664,7 ＠＠ Raw_Ichar raw = ichar_to_raw (target, fmt, wrap_buffer (buf)); while (st < lim && count > 0) { - if (BYTE_BUF_FETCH_CHAR_RAW (buf, st) == raw) + if (BYTE_BUF_ICHAR_AT_RAW (buf, st) == raw) count--; INC_BYTEBPOS (buf, st); } ＠＠ -716,7 +716,7 ＠＠ while (st > lim && count < 0) { DEC_BYTEBPOS (buf, st); - if (BYTE_BUF_FETCH_CHAR_RAW (buf, st) == raw) + if (BYTE_BUF_ICHAR_AT_RAW (buf, st) == raw) count++; } } ＠＠ -786,23 +786,31 ＠＠ } Bytebpos -byte_find_next_newline_no_quit (struct buffer *buf, Bytebpos from, int count) +byte_find_next_newline_no_quit (struct buffer *buf, Bytebpos from, + EMACS_INT count) { return byte_scan_buffer (buf, '\n', from, 0, count, 0, 0); } Charbpos -find_next_newline_no_quit (struct buffer *buf, Charbpos from, int count) +find_next_newline_no_quit (struct buffer *buf, Charbpos from, EMACS_INT count) { return scan_buffer (buf, '\n', from, 0, count, 0, 0); } Charbpos -find_next_newline (struct buffer *buf, Charbpos from, int count) +find_next_newline (struct buffer *buf, Charbpos from, EMACS_INT count) { return scan_buffer (buf, '\n', from, 0, count, 0, 1); } +Bytebpos +byte_find_next_ichar_no_quit (struct buffer *buf, Ichar target, + Bytebpos from, EMACS_INT count) +{ + return byte_scan_buffer (buf, '\n', from, 0, count, 0, 0); +} + Bytecount byte_find_next_ichar_in_string (Lisp_Object str, Ichar target, Bytecount st, EMACS_INT count) ＠＠ -822,7 +830,7 ＠＠ { while (st < lim && count > 0) { - if (string_ichar (str, st) == target) + if (string_ichar_at (str, st) == target) count--; INC_BYTECOUNT (s, st); } ＠＠ -851,7 +859,7 ＠＠ find_next_newline (...)-1, because you might hit TO. */ Charbpos find_before_next_newline (struct buffer *buf, Charbpos from, Charbpos to, - int count) + EMACS_INT count) { EMACS_INT shortage; Charbpos pos = scan_buffer (buf, '\n', from, to, count, &shortage, 1); ＠＠ -982,7 +990,7 ＠＠ while (fastmap[(unsigned char) syntax_code_spec [(int) SYNTAX_FROM_CACHE - (scache, BYTE_BUF_FETCH_CHAR (buf, pos_byte))]]) + (scache, BYTE_BUF_ICHAR_AT (buf, pos_byte))]]) { pos++; INC_BYTEBPOS (buf, pos_byte); ＠＠ -1002,7 +1010,7 ＠＠ if (!fastmap[(unsigned char) syntax_code_spec [(int) SYNTAX_FROM_CACHE - (scache, BYTE_BUF_FETCH_CHAR (buf, pos_byte))]]) + (scache, BYTE_BUF_ICHAR_AT (buf, pos_byte))]]) { pos++; pos_byte = savepos; ＠＠ -1017,7 +1025,7 ＠＠ { while (pos < limit) { - Ichar ch = BYTE_BUF_FETCH_CHAR (buf, pos_byte); + Ichar ch = BYTE_BUF_ICHAR_AT (buf, pos_byte); if ((ch < 0400) ? fastmap[ch] : (NILP (Fget_range_table (make_int (ch), Vskip_chars_range_table, ＠＠ -1039,7 +1047,7 ＠＠ Ichar ch; DEC_BYTEBPOS (buf, prev_pos_byte); - ch = BYTE_BUF_FETCH_CHAR (buf, prev_pos_byte); + ch = BYTE_BUF_ICHAR_AT (buf, prev_pos_byte); if ((ch < 0400) ? fastmap[ch] : (NILP (Fget_range_table (make_int (ch), Vskip_chars_range_table, ＠＠ -1445,7 +1453,7 ＠＠ Bytecount pat_len; pat_ch = itext_ichar (p); - buf_ch = BYTE_BUF_FETCH_CHAR (buf, this_pos); + buf_ch = BYTE_BUF_ICHAR_AT (buf, this_pos); buf_ch = TRANSLATE (trt, buf_ch); ＠＠ -1486,7 +1494,7 ＠＠ DEC_IBYTEPTR (p); DEC_BYTEBPOS (buf, this_pos); pat_ch = itext_ichar (p); - buf_ch = BYTE_BUF_FETCH_CHAR (buf, this_pos); + buf_ch = BYTE_BUF_ICHAR_AT (buf, this_pos); buf_ch = TRANSLATE (trt, buf_ch); ＠＠ -1918,7 +1926,7 ＠＠ (the reach is at most len + 21, and typically does not exceed len) */ while ((limit - pos) * direction >= 0) - /* *not* BYTE_BUF_FETCH_CHAR. We are working here + /* *not* BYTE_BUF_ICHAR_AT. We are working here with bytes, not characters. */ pos += BM_tab[*BYTE_BUF_BYTE_ADDRESS_NO_VERIFY (buf, pos)]; /* now run the same tests to distinguish going off ＠＠ -2043,14 +2051,14 ＠＠ len = string_char_length (string); for (i = 0; i < len; i++) - if (!WORD_SYNTAX_P (syntax_table, string_ichar (string, i))) + if (!WORD_SYNTAX_P (syntax_table, string_ichar_at (string, i))) { punct_count++; if (i > 0 && WORD_SYNTAX_P (syntax_table, - string_ichar (string, i - 1))) + string_ichar_at (string, i - 1))) word_count++; } - if (WORD_SYNTAX_P (syntax_table, string_ichar (string, len - 1))) + if (WORD_SYNTAX_P (syntax_table, string_ichar_at (string, len - 1))) word_count++; if (!word_count) return build_string (""); ＠＠ -2067,13 +2075,13 ＠＠ for (i = 0; i < len; i++) { - Ichar ch = string_ichar (string, i); + Ichar ch = string_ichar_at (string, i); if (WORD_SYNTAX_P (syntax_table, ch)) o += set_itext_ichar (o, ch); else if (i > 0 && WORD_SYNTAX_P (syntax_table, - string_ichar (string, i - 1)) + string_ichar_at (string, i - 1)) && --word_count) { *o++ = '\\'; ＠＠ -2503,9 +2511,9 ＠＠ for (pos = search_regs.start[sub]; pos < last; pos++) { if (NILP (string)) - c = BUF_FETCH_CHAR (buf, pos); + c = BUF_ICHAR_AT (buf, pos); else - c = string_ichar (string, pos); + c = string_ichar_at (string, pos); if (LOWERCASEP (buf, c)) { ＠＠ -2590,10 +2598,10 ＠＠ Charcount substart = -1; Charcount subend = -1; - c = string_ichar (replacement, strpos); + c = string_ichar_at (replacement, strpos); if (c == '\\' && strpos < stlen - 1) { - c = string_ichar (replacement, ++strpos); + c = string_ichar_at (replacement, ++strpos); if (c == '&') { literal_end = strpos - 1; ＠＠ -2683,7 +2691,7 ＠＠ for (strpos = 0; strpos < stlen; strpos++) { - Ichar curchar = string_ichar (replacement, strpos); + Ichar curchar = string_ichar_at (replacement, strpos); Ichar newchar = -1; if (i < Dynarr_length (ul_pos_dynarr) && strpos == Dynarr_at (ul_pos_dynarr, i)) ＠＠ -2744,7 +2752,7 ＠＠ */ Charcount offset = BUF_PT (buf) - search_regs.start[sub]; - c = string_ichar (replacement, strpos); + c = string_ichar_at (replacement, strpos); if (c == '\\' && strpos < stlen - 1) { /* XXX FIXME: replacing just a substring non-literally ＠＠ -2753,7 +2761,7 ＠＠ <duwe(a)caldera.de&gt; claims Finsert_buffer_substring already handles this correctly. */ - c = string_ichar (replacement, ++strpos); + c = string_ichar_at (replacement, ++strpos); if (c == '&') Finsert_buffer_substring (buffer, ＠＠ -2816,7 +2824,7 ＠＠ for (pos = BUF_PT (buf) - inslen; pos < eend; pos++) { - Ichar curchar = BUF_FETCH_CHAR (buf, pos); + Ichar curchar = BUF_ICHAR_AT (buf, pos); Ichar newchar = -1; if (i < Dynarr_length (ul_pos_dynarr) && pos == Dynarr_at (ul_pos_dynarr, i)) 1.39.4.1 +85 -46 XEmacs/xemacs/src/specifier.c Index: specifier.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/specifier.c,v retrieving revision 1.39 retrieving revision 1.39.4.1 diff -u -r1.39 -r1.39.4.1 --- specifier.c 2005/02/03 16:14:08 1.39 +++ specifier.c 2005/02/16 00:43:52 1.39.4.1 ＠＠ -1,6 +1,6 ＠＠ /* Specifier implementation Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995, 1996, 2002 Ben Wing. + Copyright (C) 1995, 1996, 2002, 2005 Ben Wing. Copyright (C) 1995 Sun Microsystems, Inc. This file is part of XEmacs. ＠＠ -551,30 +551,64 ＠＠ DEFUN ("make-specifier", Fmake_specifier, 1, 1, 0, /* Return a new specifier object of type TYPE. -A specifier is an object that can be used to keep track of a property -whose value can be per-buffer, per-window, per-frame, or per-device, -and can further be restricted to a particular console-type or -device-class. Specifiers are used, for example, for the various -built-in properties of a face; this allows a face to have different -values in different frames, buffers, etc. - -When speaking of the value of a specifier, it is important to -distinguish between the *setting* of a specifier, called an -\"instantiator\", and the *actual value*, called an \"instance\". You -put various possible instantiators (i.e. settings) into a specifier -and associate them with particular locales (buffer, window, frame, -device, global), and then the instance (i.e. actual value) is -retrieved in a specific domain (window, frame, device) by looking -through the possible instantiators (i.e. settings). This process is -called \"instantiation\". +A specifier is an object that can be used to keep track of a property whose +value can be per-buffer, per-window, per-frame, per-device, or per-console, +and can further be restricted to a particular console-type or device-class. +Specifiers are used, for example, for the various built-in properties of a +face; this allows a face to have different values in different frames, +buffers, etc. Specifiers provide a powerful, general mechanism for +replacing buffer-local variables, frame properties, etc. + +When speaking of the value of a specifier, it is important to understand +the difference between instantiators and instances. An "instantiator" is a +specification, indicating how to determine the specifier's value in +different circumstances. An "instance" is the resulting value in a +particular circumstance. The process of determining a specifier's value or +"instance" by looking through the instantiators is called "instantiation". + +When you add an instantiator to a specifier, you can restrict the +circumstances in which the instantiator applies by specifying a "locale" (a +buffer, window, frame, device, or "global" [i.e. no restriction]) and/or a +"tag set" (one or more symbols indicating particular device types, such as +`mswindows' or `color'). When determining a specifier's value in a +particular "domain" (usually a window), only instantiators whose locale and +tag set match the domain's properties (its buffer, frame, etc.) are +considered, and those with more specific locales are considered before +those with more general locales. + +For example, if some text in a buffer is marked with the `bold' face, then +when displaying the buffer in a particular window, the redisplay mechanism +will instantiate the `bold' face's font specifier (as well as the +foreground and background specifiers and specifiers for other face +properties) in that window and use the result to display the text. + +The domain in which a specifier's value is determined is almost always a +window, but it is possible to look up a specifier's value in a frame domain +or device domain. Note, however, that although you can set buffer-specific +instantiators, you can't instantiate a specifier in a buffer domain because +in general a buffer may be displayed in various windows, and thus there may +be no way to derive a window, frame, device, etc. from a buffer. To put settings into a specifier, use `set-specifier', or the lower-level functions `add-spec-to-specifier' and `add-spec-list-to-specifier'. You can also temporarily bind a setting to a specifier using `let-specifier'. To retrieve settings, use `specifier-specs', or its lower-level counterpart -`specifier-spec-list'. To determine the actual value, use -`specifier-instance'. +`specifier-spec-list'. + +You can determine the actual value or "instance" using +`specifier-instance'; however, normally there is no need to do so, as +XEmacs does this automatically as necessary. + +Note also that a specifier's instance may not be the same as any of its +instantiators. In particular, for specifiers that represent simple +properties (integers, booleans, etc.) the instance will be of the same type +as the instantiators, but this does not apply to specifiers representing +window-system properties. In these cases, the instantiator will be a +string, vector of properties, or a special instantiator object that +encapsulates properties, but the instance will be a special font-instance, +color-instance, or image-instance object, which contains device-specific +information about how to display itself. For more information, see `set-specifier', `specifier-instance', `specifier-specs', and `add-spec-to-specifier'; or, for a detailed ＠＠ -661,9 +695,7 ＠＠ /* This cannot GC. */ return ((DEVICEP (domain) && DEVICE_LIVE_P (XDEVICE (domain))) || (FRAMEP (domain) && FRAME_LIVE_P (XFRAME (domain))) || - (WINDOWP (domain) && WINDOW_LIVE_P (XWINDOW (domain))) || - /* #### get image instances out of domains! */ - IMAGE_INSTANCEP (domain)) + (WINDOWP (domain) && WINDOW_LIVE_P (XWINDOW (domain)))) ? Qt : Qnil; } ＠＠ -2552,10 +2584,7 ＠＠ /* Attempt to determine buffer, window, frame, and device from the domain. */ - /* #### get image instances out of domains! */ - if (IMAGE_INSTANCEP (domain)) - window = DOMAIN_WINDOW (domain); - else if (WINDOWP (domain)) + if (WINDOWP (domain)) window = domain; else if (FRAMEP (domain)) frame = domain; ＠＠ -2696,7 +2725,7 ＠＠ The returned value is dependent on the type of specifier. For example, for a font specifier (as returned by the `face-font' function), the returned value will be a font-instance object. For glyphs, the returned value -will be a string, pixmap, or subwindow. +will be a string, pixmap, widget or subwindow. See also `specifier-matching-instance'. */ ＠＠ -2713,22 +2742,15 ＠＠ } DEFUN ("specifier-matching-instance", Fspecifier_matching_instance, 2, 5, 0, /* -Return an instance for SPECIFIER in DOMAIN that matches MATCHSPEC. +Return an instance for SPECIFIER in DOMAIN, with MATCHSPEC as extra data. If no instance can be generated for this domain, return DEFAULT. -This function is identical to `specifier-instance' except that a -specification will only be considered if it matches MATCHSPEC. -The definition of "match", and allowed values for MATCHSPEC, are -dependent on the particular type of specifier. Here are some examples: +This function is identical to `specifier-instance' except that it passes in +the value of MATCHSPEC to the instantiation function. The interpretation +of MATCHSPEC depends on the type of specifier, but generally represents the +context in which the instantiator should be created and/or an additional +characteristic that the instantiator must match. Specifically: --- For chartable (e.g. display table) specifiers, MATCHSPEC should be a - character, and the specification (a chartable) must give a value for - that character in order to be considered. This allows you to specify, - e.g., a buffer-local display table that only gives values for particular - characters. All other characters are handled as if the buffer-local - display table is not there. (Chartable specifiers are not yet - implemented.) - -- For font specifiers, MATCHSPEC should be a list (CHARSET . SECOND-STAGE-P), and the specification (a font string) must have a registry that matches the charset's registry. (This only makes sense with Mule support.) This ＠＠ -2737,6 +2759,22 ＠＠ to ignore the font's registry and instead look at the characters in the font to see if the font can support the charset. This currently only makes sense under MS Windows. + +-- For chartable (e.g. display table) specifiers, MATCHSPEC should be a + character, and the specification (a chartable) must give a value for + that character in order to be considered. This allows you to specify, + e.g., a buffer-local display table that only gives values for particular + characters. All other characters are handled as if the buffer-local + display table is not there. (Chartable specifiers are not yet + implemented.) + +-- For image specifiers, MATCHSPEC can be an object (extent, toolbar button, + image instance, etc.) that the glyph that contains the image specifier + is attached to or related to. This is mostly used internally and allows + the glyph code to create different subcontrol instances for different + extents, since the same glyph may appear in the same window in two + different extents. (A window system window can appear in only one place + at a time, so we need to create two different entities.) */ (specifier, matchspec, domain, default_, no_fallback)) { ＠＠ -2784,14 +2822,15 ＠＠ Fspecifier_matching_instance_from_inst_list, 4, 5, 0, /* Attempt to convert a particular inst-list into an instance. -This attempts to instantiate INST-LIST in the given DOMAIN -\(as if INST-LIST existed in a specification in SPECIFIER), -matching the specifications against MATCHSPEC. + +This attempts to instantiate INST-LIST in the given DOMAIN \(as if +INST-LIST existed in a specification in SPECIFIER), passing in MATCHSPEC +to the instantiation function. This function is analogous to `specifier-instance-from-inst-list' -but allows for specification-matching as in `specifier-matching-instance'. -See that function for a description of exactly how the matching process -works. +but allows for arbitrary data (usually context information) to be passed in, +as in `specifier-matching-instance'. See that function for a description +of the interpretation of MATCHSPEC with different specifier types. */ (specifier, matchspec, domain, inst_list, default_)) { 1.16.4.1 +26 -23 XEmacs/xemacs/src/specifier.h Index: specifier.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/specifier.h,v retrieving revision 1.16 retrieving revision 1.16.4.1 diff -u -r1.16 -r1.16.4.1 --- specifier.h 2005/01/26 10:22:28 1.16 +++ specifier.h 2005/02/16 00:43:53 1.16.4.1 ＠＠ -1,6 +1,6 ＠＠ /* Generic specifier list implementation Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995, 1996, 2002 Ben Wing + Copyright (C) 1995, 1996, 2002, 2005 Ben Wing This file is part of XEmacs. ＠＠ -92,7 +92,12 ＠＠ /* Implementation specific methods: */ - /* Create method: Initialize specifier data. Optional. */ + /* Create method: Initialize specifier data. Optional. + + NOTE: This may be called early in initialization, in the vars_of() + routines. It's ok to loop over consoles/devices/etc., there just + won't be any. If there's stuff you're gonna do that's unsafe at + this time, conditionalize on if (initialized). */ void (*create_method) (Lisp_Object specifier); /* Mark method: Mark any lisp object within specifier data ＠＠ -189,8 +194,13 ＠＠ #### The method may have called more than once per each specifier change. + + #### Do not still know if this can safely eval. - #### Do not still know if this can safely eval. */ + NOTE: This may be called early in initialization, in the vars_of() + routines. It's ok to loop over consoles/devices/etc., there just + won't be any. If there's stuff you're gonna do that's unsafe at + this time, conditionalize on if (initialized).*/ void (*after_change_method) (Lisp_Object specifier, Lisp_Object locale); ＠＠ -432,40 +442,33 ＠＠ int always_recompute; }; -/* #### get image instances out of domains! */ - -/* #### I think the following should ABORT() rather than return nil - when an invalid domain is given; much more likely we'll catch design - errors early. --ben */ - /* This turns out to be used heavily so we make it a macro to make it inline. Also, the majority of the time the object will turn out to be a window so we move it from being checked last to being checked first. */ #define DOMAIN_DEVICE(obj) \ (WINDOWP (obj) ? WINDOW_DEVICE (XWINDOW (obj)) \ - : (FRAMEP (obj) ? FRAME_DEVICE (XFRAME (obj)) \ - : (DEVICEP (obj) ? obj \ - : (IMAGE_INSTANCEP (obj) ? image_instance_device (obj) \ - : Qnil)))) + : FRAMEP (obj) ? FRAME_DEVICE (XFRAME (obj)) \ + : DEVICEP (obj) ? obj \ + : (ABORT (), Qnil)) #define DOMAIN_FRAME(obj) \ - (WINDOWP (obj) ? WINDOW_FRAME (XWINDOW (obj)) \ - : (FRAMEP (obj) ? obj \ - : (IMAGE_INSTANCEP (obj) ? image_instance_frame (obj) \ - : Qnil))) + (WINDOWP (obj) ? WINDOW_FRAME (XWINDOW (obj)) \ + : FRAMEP (obj) ? obj \ + : DEVICEP (obj) ? Qnil \ + : (ABORT (), Qnil)) #define DOMAIN_WINDOW(obj) \ (WINDOWP (obj) ? obj \ - : (IMAGE_INSTANCEP (obj) ? image_instance_window (obj) \ - : Qnil)) + : FRAMEP (obj) ? Qnil \ + : DEVICEP (obj) ? Qnil \ + : (ABORT (), Qnil)) #define DOMAIN_LIVE_P(obj) \ (WINDOWP (obj) ? WINDOW_LIVE_P (XWINDOW (obj)) \ - : (FRAMEP (obj) ? FRAME_LIVE_P (XFRAME (obj)) \ - : (DEVICEP (obj) ? DEVICE_LIVE_P (XDEVICE (obj)) \ - : (IMAGE_INSTANCEP (obj) ? image_instance_live_p (obj) \ - : 0)))) + : FRAMEP (obj) ? FRAME_LIVE_P (XFRAME (obj)) \ + : DEVICEP (obj) ? DEVICE_LIVE_P (XDEVICE (obj)) \ + : (ABORT (), 0)) #define DOMAIN_XDEVICE(obj) \ (XDEVICE (DOMAIN_DEVICE (obj))) 1.3.6.1 +2 -0 XEmacs/xemacs/src/sunpro.c Index: sunpro.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/sunpro.c,v retrieving revision 1.3 retrieving revision 1.3.6.1 diff -u -r1.3 -r1.3.6.1 --- sunpro.c 2004/09/20 19:20:00 1.3 +++ sunpro.c 2005/02/16 00:43:54 1.3.6.1 ＠＠ -1,6 +1,7 ＠＠ /* Sunpro-specific routines. Copyright (C) 1994 Sun Microsystems, Inc. + Copyright (C) 2005 Ben Wing. This file is part of XEmacs. ＠＠ -46,6 +47,7 ＠＠ function has no effect and always returns `nil'. See function `has-usage-tracking-p'. */ + /* (format-string &rest args) */ #ifdef USAGE_TRACKING (int nargs, Lisp_Object *args) #else 1.48.4.1 +95 -53 XEmacs/xemacs/src/symbols.c Index: symbols.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/symbols.c,v retrieving revision 1.48 retrieving revision 1.48.4.1 diff -u -r1.48 -r1.48.4.1 --- symbols.c 2005/01/24 23:34:11 1.48 +++ symbols.c 2005/02/16 00:43:54 1.48.4.1 ＠＠ -1,6 +1,6 ＠＠ /* "intern" and friends -- moved here from lread.c and data.c Copyright (C) 1985-1989, 1992-1994 Free Software Foundation, Inc. - Copyright (C) 1995, 2000, 2001, 2002 Ben Wing. + Copyright (C) 1995, 2000, 2001, 2002, 2005 Ben Wing. This file is part of XEmacs. ＠＠ -244,7 +244,7 ＠＠ XSYMBOL_NEXT (symbol) = 0; *ptr = object; - if (string_byte (XSYMBOL_NAME (symbol), 0) == ':' && EQ (obarray, Vobarray)) + if (string_byte_at (XSYMBOL_NAME (symbol), 0) == ':' && EQ (obarray, Vobarray)) { /* The LISP way is to put keywords in their own package, but we don't have packages, so we do something simpler. Someday, ＠＠ -2097,6 +2097,7 ＠＠ The VALUE for the Nth SYMBOL can refer to the new default values of previous SYMBOLs. */ + /* (&rest sym-val-pairs) */ (args)) { /* This function can GC */ ＠＠ -3418,19 +3419,28 ＠＠ static void check_sane_subr (Lisp_Subr *subr, Lisp_Object sym) { - if (!initialized) { - assert (subr->min_args >= 0); - assert (subr->min_args <= SUBR_MAX_ARGS); + if (!initialized) + { + assert (subr->min_args >= 0); + assert (subr->min_args <= SUBR_MAX_ARGS); - if (subr->max_args != MANY && - subr->max_args != UNEVALLED) - { - /* Need to fix lisp.h and eval.c if SUBR_MAX_ARGS too small */ - assert (subr->max_args <= SUBR_MAX_ARGS); - assert (subr->min_args <= subr->max_args); - } - assert (UNBOUNDP (XSYMBOL (sym)->function)); - } + if (subr->max_args <= KEYWORD_NEGATIVE_ARG_CONVERTER) + { + int max_args = KEYWORD_NEGATIVE_ARG_CONVERTER - subr->max_args; + /* Need to fix lisp.h and eval.c if SUBR_MAX_ARGS too small */ + assert (max_args <= SUBR_MAX_ARGS); + assert (subr->min_args <= max_args); + assert (subr->num_keywords <= SUBR_MAX_KEYWORD_ARGS); + } + else if (subr->max_args != MANY && subr->max_args != UNEVALLED) + { + /* Need to fix lisp.h and eval.c if SUBR_MAX_ARGS too small */ + assert (subr->max_args <= SUBR_MAX_ARGS); + assert (subr->min_args <= subr->max_args); + } + + assert (UNBOUNDP (XSYMBOL (sym)->function)); + } } #else #define check_sane_subr(subr, sym) /* nothing */ ＠＠ -3458,48 +3468,78 ＠＠ * Code can then get this value from the static subr structure and use * it if required. * - * FIXME: Should newsubr be staticpro()'ed? I don't think so but I need + * #### Should newsubr be staticpro()'ed? I don't think so but I need * a guru to check. */ -#define check_module_subr(subr) \ -do { \ - if (initialized) { \ - Lisp_Subr *newsubr; \ - Lisp_Object f; \ - \ - if (subr->min_args < 0) \ - signal_ferror (Qdll_error, "%s min_args (%hd) too small", \ - subr_name (subr), subr->min_args); \ - if (subr->min_args > SUBR_MAX_ARGS) \ - signal_ferror (Qdll_error, "%s min_args (%hd) too big (max = %d)", \ - subr_name (subr), subr->min_args, SUBR_MAX_ARGS); \ - \ - if (subr->max_args != MANY && \ - subr->max_args != UNEVALLED) \ - { \ - /* Need to fix lisp.h and eval.c if SUBR_MAX_ARGS too small */ \ - if (subr->max_args > SUBR_MAX_ARGS) \ - signal_ferror (Qdll_error, "%s max_args (%hd) too big (max = %d)", \ - subr_name (subr), subr->max_args, SUBR_MAX_ARGS); \ - if (subr->min_args > subr->max_args) \ - signal_ferror (Qdll_error, "%s min_args (%hd) > max_args (%hd)", \ - subr_name (subr), subr->min_args, subr->max_args); \ - } \ - \ - f = XSYMBOL (sym)->function; \ - if (!UNBOUNDP (f) && (!CONSP (f) || !EQ (XCAR (f), Qautoload))) \ - signal_ferror (Qdll_error, "Attempt to redefine %s", subr_name (subr)); \ - \ - newsubr = xnew (Lisp_Subr); \ - memcpy (newsubr, subr, sizeof (Lisp_Subr)); \ - subr->doc = (const char *)newsubr; \ - subr = newsubr; \ - } \ -} while (0) +static void +check_module_subr (Lisp_Subr *subr, Lisp_Object sym) +{ + if (initialized) + { + Lisp_Subr *newsubr; + Lisp_Object f; + + if (subr->min_args < 0) + signal_ferror (Qdll_error, "%s min_args (%hd) too small", + subr_name (subr), subr->min_args); + if (subr->min_args > SUBR_MAX_ARGS) + signal_ferror (Qdll_error, "%s min_args (%hd) too big (max = %d)", + subr_name (subr), subr->min_args, SUBR_MAX_ARGS); + + if (subr->max_args != MANY && + subr->max_args != UNEVALLED) + { + /* Need to fix lisp.h and eval.c if SUBR_MAX_ARGS too small */ + if (subr->max_args > SUBR_MAX_ARGS) + signal_ferror (Qdll_error, "%s max_args (%hd) too big (max = %d)", + subr_name (subr), subr->max_args, SUBR_MAX_ARGS); + if (subr->min_args > subr->max_args) + signal_ferror (Qdll_error, "%s min_args (%hd) > max_args (%hd)", + subr_name (subr), subr->min_args, subr->max_args); + } + + f = XSYMBOL (sym)->function; + if (!UNBOUNDP (f) && (!CONSP (f) || !EQ (XCAR (f), Qautoload))) + signal_ferror (Qdll_error, "Attempt to redefine %s", subr_name (subr)); + + newsubr = xnew (Lisp_Subr); + memcpy (newsubr, subr, sizeof (Lisp_Subr)); + subr->doc = (const char *)newsubr; + subr = newsubr; + } +} #else /* ! HAVE_SHLIB */ -#define check_module_subr(subr) +#define check_module_subr(subr, sym) #endif +static void +init_keyword_args (Lisp_Subr *subr) +{ + int j; + + for (j = 0; j < subr->num_keywords; j++) + { + /* unfortunately we can't use defkeyword_massage_name() because + the name has no Q_ in it. */ + char temp[500]; + const char *name = subr->keywords[j]; + Lisp_Object *location = &subr->keyword_syms[j]; + int len = strlen (name) + 1; /* add : to beginning */ + int i; + + assert (len < (int) sizeof (temp)); + temp[0] = ':'; + strcpy (temp + 1, name); + for (i = 0; i < len; i++) + if (temp[i] == '_') + temp[i] = '-'; + *location = Fintern (make_string ((const Ibyte *) temp, len), Qnil); + /* What's the secret? It's location, location, location ... */ + staticpro (location); + Fset (*location, *location); + } +} + void defsubr (Lisp_Subr *subr) { ＠＠ -3507,7 +3547,8 ＠＠ Lisp_Object fun; check_sane_subr (subr, sym); - check_module_subr (subr); + check_module_subr (subr, sym); + init_keyword_args (subr); fun = wrap_subr (subr); XSYMBOL (sym)->function = fun; ＠＠ -3527,7 +3568,8 ＠＠ Lisp_Object fun; check_sane_subr (subr, sym); - check_module_subr (subr); + check_module_subr (subr, sym); + init_keyword_args (subr); fun = wrap_subr (subr); XSYMBOL (sym)->function = Fcons (Qmacro, fun); 1.51.4.1 +3 -13 XEmacs/xemacs/src/symsinit.h Index: symsinit.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/symsinit.h,v retrieving revision 1.51 retrieving revision 1.51.4.1 diff -u -r1.51 -r1.51.4.1 --- symsinit.h 2005/01/28 02:36:26 1.51 +++ symsinit.h 2005/02/16 00:43:55 1.51.4.1 ＠＠ -199,6 +199,9 ＠＠ void console_type_create_frame_tty (void); void console_type_create_objects_tty (void); void console_type_create_redisplay_tty (void); +void console_type_create_xlike (void); +void reinit_console_type_create_xlike (void); +void console_type_create_redisplay_xlike (void); void console_type_create_x (void); void reinit_console_type_create_x (void); void console_type_create_device_x (void); ＠＠ -439,28 +442,15 ＠＠ EXTERN_C void vars_of_postgresql (void); void vars_of_gpmevent (void); -/* Initialize specifier variables (dump-time only). */ - -void specifier_vars_of_glyphs (void); -void specifier_vars_of_glyphs_widget (void); -void specifier_vars_of_gutter (void); -void specifier_vars_of_menubar (void); -void specifier_vars_of_redisplay (void); -void specifier_vars_of_scrollbar (void); -void specifier_vars_of_toolbar (void); -void specifier_vars_of_window (void); - /* Initialize variables with complex dependencies on other variables (dump-time for complex_vars_, dump-time and post-pdump-load-time for reinit_(), pdump-load-time-only for reinit_..._runtime_only()). #### The reinit_() functions should be called from emacs.c, not the corresponding complex_vars_of_(). */ -void complex_vars_of_faces (void); void complex_vars_of_mule_charset (void); void complex_vars_of_file_coding (void); void complex_vars_of_intl_win32 (void); -void complex_vars_of_glyphs (void); void complex_vars_of_glyphs_x (void); void complex_vars_of_glyphs_mswindows (void); void complex_vars_of_alloc (void); 1.23.4.1 +44 -45 XEmacs/xemacs/src/syntax.c Index: syntax.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/syntax.c,v retrieving revision 1.23 retrieving revision 1.23.4.1 diff -u -r1.23 -r1.23.4.1 --- syntax.c 2005/01/26 05:11:12 1.23 +++ syntax.c 2005/02/16 00:43:55 1.23.4.1 ＠＠ -1,7 +1,7 ＠＠ /* XEmacs routines to deal with syntax tables; also word and list parsing. Copyright (C) 1985-1994 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 2001, 2002, 2003 Ben Wing. + Copyright (C) 2001, 2002, 2003, 2005 Ben Wing. This file is part of XEmacs. ＠＠ -128,7 +128,7 ＠＠ UPDATE_SYNTAX_CACHE_BACKWARD (scache, tem); /* Open-paren at start of line means we found our defun-start. */ - if (SYNTAX_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, tem)) == Sopen) + if (SYNTAX_FROM_CACHE (scache, BUF_ICHAR_AT (buf, tem)) == Sopen) break; /* Move to beg of previous line. */ tem = find_next_newline (buf, tem, -2); ＠＠ -281,8 +281,7 ＠＠ if (count <= 0) { from--; - from = buffer_or_string_clip_to_accessible_char (cache->object, - from); + from = textobj_clip_to_accessible_char (cache->object, from); } if (!(from >= cache->prev_change && from < cache->next_change)) update_syntax_cache (cache, from, count); ＠＠ -444,7 +443,7 ＠＠ if (NILP (cache->object)) return; - pos = buffer_or_string_charxpos_to_bytexpos (cache->object, cpos); + pos = textobj_charxpos_to_bytexpos (cache->object, cpos); tmp_table = get_char_property (pos, Qsyntax_table, cache->object, EXTENT_AT_AFTER, 0); ＠＠ -452,28 +451,28 ＠＠ cache->object, -1, 1, 0); if (lim < 0) { - next = buffer_or_string_absolute_end_byte (cache->object); + next = textobj_absolute_end_byte (cache->object); at_begin = 1; } else next = lim; - if (pos < buffer_or_string_absolute_end_byte (cache->object)) + if (pos < textobj_absolute_end_byte (cache->object)) pos = next_bytexpos (cache->object, pos); lim = next_previous_single_property_change (pos, Qsyntax_table, cache->object, -1, 0, 0); if (lim < 0) { - prev = buffer_or_string_absolute_begin_byte (cache->object); + prev = textobj_absolute_begin_byte (cache->object); at_end = 1; } else prev = lim; cache->prev_change = - buffer_or_string_bytexpos_to_charxpos (cache->object, prev); + textobj_bytexpos_to_charxpos (cache->object, prev); cache->next_change = - buffer_or_string_bytexpos_to_charxpos (cache->object, next); + textobj_bytexpos_to_charxpos (cache->object, next); if (BUFFERP (cache->object)) { ＠＠ -669,7 +668,7 ＠＠ return 0; UPDATE_SYNTAX_CACHE_FORWARD (scache, from); - ch0 = BUF_FETCH_CHAR (buf, from); + ch0 = BUF_ICHAR_AT (buf, from); code = SYNTAX_FROM_CACHE (scache, ch0); from++; ＠＠ -685,7 +684,7 ＠＠ while (from != limit) { UPDATE_SYNTAX_CACHE_FORWARD (scache, from); - ch1 = BUF_FETCH_CHAR (buf, from); + ch1 = BUF_ICHAR_AT (buf, from); code = SYNTAX_FROM_CACHE (scache, ch1); if (!(words_include_escapes && (code == Sescape || code == Scharquote))) ＠＠ -713,7 +712,7 ＠＠ return 0; UPDATE_SYNTAX_CACHE_BACKWARD (scache, from - 1); - ch1 = BUF_FETCH_CHAR (buf, from - 1); + ch1 = BUF_ICHAR_AT (buf, from - 1); code = SYNTAX_FROM_CACHE (scache, ch1); from--; ＠＠ -729,7 +728,7 ＠＠ while (from != limit) { UPDATE_SYNTAX_CACHE_BACKWARD (scache, from - 1); - ch0 = BUF_FETCH_CHAR (buf, from - 1); + ch0 = BUF_ICHAR_AT (buf, from - 1); code = SYNTAX_FROM_CACHE (scache, ch0); if (!(words_include_escapes ＠＠ -835,7 +834,7 ＠＠ from--; UPDATE_SYNTAX_CACHE_BACKWARD (scache, from); - c = BUF_FETCH_CHAR (buf, from); + c = BUF_ICHAR_AT (buf, from); syncode = SYNTAX_CODE_FROM_CACHE (scache, c); code = SYNTAX_FROM_CODE (syncode); ＠＠ -866,7 +865,7 ＠＠ UPDATE_SYNTAX_CACHE_BACKWARD (scache, from - 1); prev_syncode = SYNTAX_CODE_FROM_CACHE (scache, - BUF_FETCH_CHAR (buf, from - 1)); + BUF_ICHAR_AT (buf, from - 1)); if (SYNTAX_CODES_END_P (prev_syncode, syncode)) { ＠＠ -876,7 +875,7 ＠＠ syncode) & mask; from--; UPDATE_SYNTAX_CACHE_BACKWARD (scache, from); - c = BUF_FETCH_CHAR (buf, from); + c = BUF_ICHAR_AT (buf, from); /* Found a comment-end sequence, so skip past the check for a comment-start */ ＠＠ -891,7 +890,7 ＠＠ UPDATE_SYNTAX_CACHE_BACKWARD (scache, from - 1); prev_syncode = SYNTAX_CODE_FROM_CACHE (scache, - BUF_FETCH_CHAR (buf, from - 1)); + BUF_ICHAR_AT (buf, from - 1)); if (SYNTAX_CODES_START_P (prev_syncode, syncode)) { ＠＠ -901,7 +900,7 ＠＠ syncode) & mask; from--; UPDATE_SYNTAX_CACHE_BACKWARD (scache, from); - c = BUF_FETCH_CHAR (buf, from); + c = BUF_ICHAR_AT (buf, from); } } } while (0); ＠＠ -951,7 +950,7 ＠＠ /* Assume a defun-start point is outside of strings. */ if (code == Sopen - && (from == stop || BUF_FETCH_CHAR (buf, from - 1) == '\n')) + && (from == stop || BUF_ICHAR_AT (buf, from - 1) == '\n')) break; } ＠＠ -1006,7 +1005,7 ＠＠ } UPDATE_SYNTAX_CACHE_FORWARD (scache, from); - c = BUF_FETCH_CHAR (buf, from); + c = BUF_ICHAR_AT (buf, from); /* Test for generic comments */ if (comstyle == ST_COMMENT_STYLE) ＠＠ -1041,7 +1040,7 ＠＠ if (from < stop && SYNTAX_CODES_MATCH_END_P (prev_code, - SYNTAX_CODE_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from)), + SYNTAX_CODE_FROM_CACHE (scache, BUF_ICHAR_AT (buf, from)), mask) ) ＠＠ -1112,7 +1111,7 ＠＠ } UPDATE_SYNTAX_CACHE_FORWARD (scache, from); - c = BUF_FETCH_CHAR (buf, from); + c = BUF_ICHAR_AT (buf, from); syncode = SYNTAX_CODE_FROM_CACHE (scache, c); code = SYNTAX_FROM_CODE (syncode); ＠＠ -1140,7 +1139,7 ＠＠ int next_syncode; UPDATE_SYNTAX_CACHE_FORWARD (scache, from + 1); next_syncode = - SYNTAX_CODE_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from + 1)); + SYNTAX_CODE_FROM_CACHE (scache, BUF_ICHAR_AT (buf, from + 1)); if (SYNTAX_CODES_START_P (syncode, next_syncode)) { ＠＠ -1202,7 +1201,7 ＠＠ continue; } - c = BUF_FETCH_CHAR (buf, from); + c = BUF_ICHAR_AT (buf, from); syncode = SYNTAX_CODE_FROM_CACHE (scache, c); code = SYNTAX_FROM_CODE (syncode); ＠＠ -1227,7 +1226,7 ＠＠ int prev_syncode; UPDATE_SYNTAX_CACHE_BACKWARD (scache, from - 1); prev_syncode = - SYNTAX_CODE_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from - 1)); + SYNTAX_CODE_FROM_CACHE (scache, BUF_ICHAR_AT (buf, from - 1)); if (SYNTAX_CODES_END_P (prev_syncode, syncode)) { /* We must record the comment style encountered so that ＠＠ -1289,7 +1288,7 ＠＠ int comstyle = 0; /* mask for finding matching comment style */ UPDATE_SYNTAX_CACHE_FORWARD (scache, from); - c = BUF_FETCH_CHAR (buf, from); + c = BUF_ICHAR_AT (buf, from); syncode = SYNTAX_CODE_FROM_CACHE (scache, c); code = SYNTAX_FROM_CODE (syncode); from++; ＠＠ -1309,7 +1308,7 ＠＠ int next_syncode; UPDATE_SYNTAX_CACHE_FORWARD (scache, from); next_syncode = - SYNTAX_CODE_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from)); + SYNTAX_CODE_FROM_CACHE (scache, BUF_ICHAR_AT (buf, from)); if (SYNTAX_CODES_START_P (syncode, next_syncode)) { ＠＠ -1343,7 +1342,7 ＠＠ while (from < stop) { UPDATE_SYNTAX_CACHE_FORWARD (scache, from); - switch (SYNTAX_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from))) + switch (SYNTAX_FROM_CACHE (scache, BUF_ICHAR_AT (buf, from))) { case Scharquote: case Sescape: ＠＠ -1385,7 +1384,7 ＠＠ case Smath: if (!sexpflag) break; - if (from != stop && c == BUF_FETCH_CHAR (buf, from)) + if (from != stop && c == BUF_ICHAR_AT (buf, from)) from++; if (mathexit) { ＠＠ -1418,7 +1417,7 ＠＠ if (code != Sstring_fence) { /* XEmacs change: call syntax_match on character */ - Ichar ch = BUF_FETCH_CHAR (buf, from - 1); + Ichar ch = BUF_ICHAR_AT (buf, from - 1); Lisp_Object stermobj = syntax_match (scache->syntax_table, ch); ＠＠ -1435,7 +1434,7 ＠＠ if (from >= stop) goto lose; UPDATE_SYNTAX_CACHE_FORWARD (scache, from); - c = BUF_FETCH_CHAR (buf, from); + c = BUF_ICHAR_AT (buf, from); if (code == Sstring ? c == stringterm : SYNTAX_FROM_CACHE (scache, c) == Sstring_fence) ＠＠ -1491,7 +1490,7 ＠＠ UPDATE_SYNTAX_CACHE_BACKWARD (scache, from); } - c = BUF_FETCH_CHAR (buf, from); + c = BUF_ICHAR_AT (buf, from); syncode = SYNTAX_CODE_FROM_CACHE (scache, c); code = SYNTAX_FROM_CODE (syncode); ＠＠ -1512,7 +1511,7 ＠＠ int prev_syncode; UPDATE_SYNTAX_CACHE_BACKWARD (scache, from - 1); prev_syncode = - SYNTAX_CODE_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from - 1)); + SYNTAX_CODE_FROM_CACHE (scache, BUF_ICHAR_AT (buf, from - 1)); if (SYNTAX_CODES_END_P (prev_syncode, syncode)) { ＠＠ -1545,7 +1544,7 ＠＠ from--; if (! (quoted || (syncode = - SYNTAX_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, + SYNTAX_FROM_CACHE (scache, BUF_ICHAR_AT (buf, from - 1))) == Sword || syncode == Ssymbol ＠＠ -1558,7 +1557,7 ＠＠ case Smath: if (!sexpflag) break; - if (from != stop && c == BUF_FETCH_CHAR (buf, from - 1)) + if (from != stop && c == BUF_ICHAR_AT (buf, from - 1)) from--; if (mathexit) { ＠＠ -1598,7 +1597,7 ＠＠ if (code != Sstring_fence) { /* XEmacs change: call syntax_match() on character */ - Ichar ch = BUF_FETCH_CHAR (buf, from); + Ichar ch = BUF_ICHAR_AT (buf, from); Lisp_Object stermobj = syntax_match (scache->syntax_table, ch); ＠＠ -1615,7 +1614,7 ＠＠ if (from == stop) goto lose; UPDATE_SYNTAX_CACHE_BACKWARD (scache, from - 1); - c = BUF_FETCH_CHAR (buf, from - 1); + c = BUF_ICHAR_AT (buf, from - 1); if ((code == Sstring ? c == stringterm ＠＠ -1665,7 +1664,7 ＠＠ while (pos > beg) { UPDATE_SYNTAX_CACHE_BACKWARD (scache, pos - 1); - code = SYNTAX_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, pos - 1)); + code = SYNTAX_FROM_CACHE (scache, BUF_ICHAR_AT (buf, pos - 1)); if (code != Scharquote && code != Sescape) break; ＠＠ -1756,7 +1755,7 ＠＠ while (pos > beg && !char_quoted (buf, pos - 1) /* Previous statement updates syntax table. */ - && (SYNTAX_FROM_CACHE (scache, c = BUF_FETCH_CHAR (buf, pos - 1)) == Squote + && (SYNTAX_FROM_CACHE (scache, c = BUF_ICHAR_AT (buf, pos - 1)) == Squote || SYNTAX_CODE_PREFIX (SYNTAX_CODE_FROM_CACHE (scache, c)))) pos--; ＠＠ -1881,7 +1880,7 ＠＠ QUIT; UPDATE_SYNTAX_CACHE_FORWARD (scache, from); - c = BUF_FETCH_CHAR (buf, from); + c = BUF_ICHAR_AT (buf, from); syncode = SYNTAX_CODE_FROM_CACHE (scache, c); code = SYNTAX_FROM_CODE (syncode); from++; ＠＠ -1911,7 +1910,7 ＠＠ int next_syncode; UPDATE_SYNTAX_CACHE_FORWARD (scache, from); next_syncode = - SYNTAX_CODE_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from)); + SYNTAX_CODE_FROM_CACHE (scache, BUF_ICHAR_AT (buf, from)); if (SYNTAX_CODES_START_P (syncode, next_syncode)) { ＠＠ -1945,7 +1944,7 ＠＠ while (from < end) { UPDATE_SYNTAX_CACHE_FORWARD (scache, from); - switch (SYNTAX_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from))) + switch (SYNTAX_FROM_CACHE (scache, BUF_ICHAR_AT (buf, from))) { case Scharquote: case Sescape: ＠＠ -2023,7 +2022,7 ＠＠ else { /* XEmacs change: call syntax_match() on character */ - Ichar ch = BUF_FETCH_CHAR (buf, from - 1); + Ichar ch = BUF_ICHAR_AT (buf, from - 1); Lisp_Object stermobj = syntax_match (scache->syntax_table, ch); ＠＠ -2041,7 +2040,7 ＠＠ if (from >= end) goto done; UPDATE_SYNTAX_CACHE_FORWARD (scache, from); - c = BUF_FETCH_CHAR (buf, from); + c = BUF_ICHAR_AT (buf, from); temp_code = SYNTAX_FROM_CACHE (scache, c); if ( 1.26.4.1 +1 -1 XEmacs/xemacs/src/syswindows.h Index: syswindows.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/syswindows.h,v retrieving revision 1.26 retrieving revision 1.26.4.1 diff -u -r1.26 -r1.26.4.1 --- syswindows.h 2005/01/28 02:36:27 1.26 +++ syswindows.h 2005/02/16 00:43:56 1.26.4.1 ＠＠ -1,5 +1,5 ＠＠ /* Copyright (C) 2000 Free Software Foundation, Inc. - Copyright (C) 2000, 2001, 2002, 2004 Ben Wing. + Copyright (C) 2000, 2001, 2002, 2004, 2005 Ben Wing. This file is part of XEmacs. 1.10.6.1 +1 -1 XEmacs/xemacs/src/tests.c Index: tests.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/tests.c,v retrieving revision 1.10 retrieving revision 1.10.6.1 diff -u -r1.10 -r1.10.6.1 --- tests.c 2004/09/20 19:20:02 1.10 +++ tests.c 2005/02/16 00:43:56 1.10.6.1 ＠＠ -442,7 +442,7 ＠＠ ()) { test_hash_tables_data data; - data.hash_table = make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, + data.hash_table = make_lisp_hash_table (50, hash_table_non_weak, HASH_TABLE_EQUAL); Fputhash (make_int (1), make_int (2), data.hash_table); 1.24.4.1 +20 -72 XEmacs/xemacs/src/text.c Index: text.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/text.c,v retrieving revision 1.24 retrieving revision 1.24.4.1 diff -u -r1.24 -r1.24.4.1 --- text.c 2005/01/24 23:34:12 1.24 +++ text.c 2005/02/16 00:43:56 1.24.4.1 ＠＠ -1,6 +1,6 ＠＠ /* Text manipulation primitives for XEmacs. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1995, 1996, 2000, 2001, 2002, 2003, 2004 Ben Wing. + Copyright (C) 1995, 1996, 2000, 2001, 2002, 2003, 2004, 2005 Ben Wing. Copyright (C) 1999 Martin Buchholz. This file is part of XEmacs. ＠＠ -3853,7 +3853,7 ＠＠ } Charxpos -get_buffer_or_string_pos_char (Lisp_Object object, Lisp_Object pos, +get_textobj_pos_char (Lisp_Object object, Lisp_Object pos, unsigned int flags) { return STRINGP (object) ? ＠＠ -3862,7 +3862,7 ＠＠ } Bytexpos -get_buffer_or_string_pos_byte (Lisp_Object object, Lisp_Object pos, +get_textobj_pos_byte (Lisp_Object object, Lisp_Object pos, unsigned int flags) { return STRINGP (object) ? ＠＠ -3871,7 +3871,7 ＠＠ } void -get_buffer_or_string_range_char (Lisp_Object object, Lisp_Object from, +get_textobj_range_char (Lisp_Object object, Lisp_Object from, Lisp_Object to, Charxpos *from_out, Charxpos *to_out, unsigned int flags) { ＠＠ -3883,7 +3883,7 ＠＠ } void -get_buffer_or_string_range_byte (Lisp_Object object, Lisp_Object from, +get_textobj_range_byte (Lisp_Object object, Lisp_Object from, Lisp_Object to, Bytexpos *from_out, Bytexpos *to_out, unsigned int flags) { ＠＠ -3894,58 +3894,6 ＠＠ flags); } -Charxpos -buffer_or_string_accessible_begin_char (Lisp_Object object) -{ - return STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object)); -} - -Charxpos -buffer_or_string_accessible_end_char (Lisp_Object object) -{ - return STRINGP (object) ? - string_char_length (object) : BUF_ZV (XBUFFER (object)); -} - -Bytexpos -buffer_or_string_accessible_begin_byte (Lisp_Object object) -{ - return STRINGP (object) ? 0 : BYTE_BUF_BEGV (XBUFFER (object)); -} - -Bytexpos -buffer_or_string_accessible_end_byte (Lisp_Object object) -{ - return STRINGP (object) ? - XSTRING_LENGTH (object) : BYTE_BUF_ZV (XBUFFER (object)); -} - -Charxpos -buffer_or_string_absolute_begin_char (Lisp_Object object) -{ - return STRINGP (object) ? 0 : BUF_BEG (XBUFFER (object)); -} - -Charxpos -buffer_or_string_absolute_end_char (Lisp_Object object) -{ - return STRINGP (object) ? - string_char_length (object) : BUF_Z (XBUFFER (object)); -} - -Bytexpos -buffer_or_string_absolute_begin_byte (Lisp_Object object) -{ - return STRINGP (object) ? 0 : BYTE_BUF_BEG (XBUFFER (object)); -} - -Bytexpos -buffer_or_string_absolute_end_byte (Lisp_Object object) -{ - return STRINGP (object) ? - XSTRING_LENGTH (object) : BYTE_BUF_Z (XBUFFER (object)); -} - Charbpos charbpos_clip_to_bounds (Charbpos lower, Charbpos num, Charbpos upper) { ＠＠ -3978,40 +3926,40 ＠＠ num); } -/* These could be implemented in terms of the get_buffer_or_string() +/* These could be implemented in terms of the get_textobj() functions above, but those are complicated and handle lots of weird cases stemming from uncertain external input. */ Charxpos -buffer_or_string_clip_to_accessible_char (Lisp_Object object, Charxpos pos) +textobj_clip_to_accessible_char (Lisp_Object object, Charxpos pos) { return (charxpos_clip_to_bounds - (pos, buffer_or_string_accessible_begin_char (object), - buffer_or_string_accessible_end_char (object))); + (pos, textobj_accessible_begin_char (object), + textobj_accessible_end_char (object))); } Bytexpos -buffer_or_string_clip_to_accessible_byte (Lisp_Object object, Bytexpos pos) +textobj_clip_to_accessible_byte (Lisp_Object object, Bytexpos pos) { return (bytexpos_clip_to_bounds - (pos, buffer_or_string_accessible_begin_byte (object), - buffer_or_string_accessible_end_byte (object))); + (pos, textobj_accessible_begin_byte (object), + textobj_accessible_end_byte (object))); } Charxpos -buffer_or_string_clip_to_absolute_char (Lisp_Object object, Charxpos pos) +textobj_clip_to_absolute_char (Lisp_Object object, Charxpos pos) { return (charxpos_clip_to_bounds - (pos, buffer_or_string_absolute_begin_char (object), - buffer_or_string_absolute_end_char (object))); + (pos, textobj_absolute_begin_char (object), + textobj_absolute_end_char (object))); } Bytexpos -buffer_or_string_clip_to_absolute_byte (Lisp_Object object, Bytexpos pos) +textobj_clip_to_absolute_byte (Lisp_Object object, Bytexpos pos) { return (bytexpos_clip_to_bounds - (pos, buffer_or_string_absolute_begin_byte (object), - buffer_or_string_absolute_end_byte (object))); + (pos, textobj_absolute_begin_byte (object), + textobj_absolute_end_byte (object))); }  ＠＠ -5166,9 +5114,9 ＠＠ composite_char_col_next = 32; Vcomposite_char_string2char_hash_table = - make_lisp_hash_table (500, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); + make_lisp_hash_table (500, hash_table_non_weak, HASH_TABLE_EQUAL); Vcomposite_char_char2string_hash_table = - make_lisp_hash_table (500, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (500, hash_table_non_weak, HASH_TABLE_EQ); staticpro (&Vcomposite_char_string2char_hash_table); staticpro (&Vcomposite_char_char2string_hash_table); #endif /* ENABLE_COMPOSITE_CHARS */ 1.28.4.1 +11 -9 XEmacs/xemacs/src/text.h Index: text.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/text.h,v retrieving revision 1.28 retrieving revision 1.28.4.1 diff -u -r1.28 -r1.28.4.1 --- text.h 2005/01/28 02:36:27 1.28 +++ text.h 2005/02/16 00:43:58 1.28.4.1 ＠＠ -1082,9 +1082,9 ＠＠ #define string_char_length(s) \ string_index_byte_to_char (s, XSTRING_LENGTH (s)) -#define string_byte(s, i) (XSTRING_DATA (s)[i] + 0) +#define string_byte_at(s, i) (XSTRING_DATA (s)[i] + 0) /* In case we ever allow strings to be in a different format ... */ -#define set_string_byte(s, i, c) (XSTRING_DATA (s)[i] = (c)) +#define set_string_byte_at(s, i, c) (XSTRING_DATA (s)[i] = (c)) #define ASSERT_VALID_CHAR_STRING_INDEX_UNSAFE(s, x) do { \ text_checking_assert ((x) >= 0 && x <= string_char_length (s)); \ ＠＠ -1092,15 +1092,17 ＠＠ #define ASSERT_VALID_BYTE_STRING_INDEX_UNSAFE(s, x) do { \ text_checking_assert ((x) >= 0 && x <= XSTRING_LENGTH (s)); \ - text_checking_assert (valid_ibyteptr_p (string_byte_addr (s, x))); \ + text_checking_assert (valid_ibyteptr_p (string_byte_at_addr (s, x))); \ } while (0) /* Convert offset I in string S to a pointer to text there. */ -#define string_byte_addr(s, i) (&(XSTRING_DATA (s)[i])) +#define string_byte_at_addr(s, i) (&(XSTRING_DATA (s)[i])) /* Convert pointer to text in string S into the byte offset to that text. */ #define string_addr_to_byte(s, ptr) ((Bytecount) ((ptr) - XSTRING_DATA (s))) /* Return the Ichar at *CHARACTER* offset I. */ -#define string_ichar(s, i) itext_ichar (string_char_addr (s, i)) +#define string_ichar_at(s, i) itext_ichar (string_char_addr (s, i)) +/* Return the Ichar at byte offset I. */ +#define string_ichar_at_byte(s, i) itext_ichar (string_byte_at_addr (s, i)) #ifdef ERROR_CHECK_TEXT #define SLEDGEHAMMER_CHECK_ASCII_BEGIN ＠＠ -1256,7 +1258,7 ＠＠ #ifdef MULE void set_string_char (Lisp_Object s, Charcount i, Ichar c); #else -#define set_string_char(s, i, c) set_string_byte (s, i, c) +#define set_string_char(s, i, c) set_string_byte_at (s, i, c) #endif /* not MULE */ /* Return index to character before the one at IDX. */ ＠＠ -1265,7 +1267,7 ＠＠ prev_string_index (Lisp_Object s, Bytecount idx) ) { - const Ibyte *ptr = string_byte_addr (s, idx); + const Ibyte *ptr = string_byte_at_addr (s, idx); DEC_IBYTEPTR (ptr); return string_addr_to_byte (s, ptr); } ＠＠ -1276,7 +1278,7 ＠＠ next_string_index (Lisp_Object s, Bytecount idx) ) { - const Ibyte *ptr = string_byte_addr (s, idx); + const Ibyte *ptr = string_byte_at_addr (s, idx); INC_IBYTEPTR (ptr); return string_addr_to_byte (s, ptr); } ＠＠ -3200,7 +3202,7 ＠＠ \ if (!__gserr__) \ { \ - var = alloca_ibytes (99); \ + var = alloca_ibytes (99); \ qxesprintf (var, "Unknown error %d", __gsnum__); \ } \ else \ 1.11.4.1 +6 -5 XEmacs/xemacs/src/toolbar-common.c Index: toolbar-common.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/toolbar-common.c,v retrieving revision 1.11 retrieving revision 1.11.4.1 diff -u -r1.11 -r1.11.4.1 --- toolbar-common.c 2005/01/24 23:34:12 1.11 +++ toolbar-common.c 2005/02/16 00:43:59 1.11.4.1 ＠＠ -218,7 +218,8 ＠＠ /* #### It is currently possible for users to trash us by directly changing the toolbar glyphs. Avoid crashing in that case. */ if (GLYPHP (glyph)) - instance = glyph_image_instance (glyph, window, ERROR_ME_DEBUG_WARN, 1); + instance = glyph_image_instance (glyph, window, button, + ERROR_ME_DEBUG_WARN, 1); else instance = Qnil; ＠＠ -263,7 +264,7 ＠＠ redisplay_output_pixmap (w, instance, &db, &dga, - toolbar_findex, 0, 0, 0, 0); + toolbar_findex, 0); } else if (IMAGE_INSTANCE_TYPE (p) == IMAGE_TEXT) { ＠＠ -309,7 +310,7 ＠＠ MAYBE_DEVMETH (d, output_string, (w, &dl, buf, tb->x + x_offset, 0, 0, width, - toolbar_findex, 0, 0, 0, 0)); + toolbar_findex)); Dynarr_free (buf); } ＠＠ -345,9 +346,9 ＠＠ return XINT (f->toolbar_size[pos]); if (vert) - size = glyph_height (glyph, window); + size = glyph_height (glyph, window, wrap_toolbar_button (tb)); else - size = glyph_width (glyph, window); + size = glyph_width (glyph, window, wrap_toolbar_button (tb)); } if (!size) 1.25.4.1 +8 -11 XEmacs/xemacs/src/toolbar-msw.c Index: toolbar-msw.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/toolbar-msw.c,v retrieving revision 1.25 retrieving revision 1.25.4.1 diff -u -r1.25 -r1.25.4.1 --- toolbar-msw.c 2005/01/24 23:34:12 1.25 +++ toolbar-msw.c 2005/02/16 00:43:59 1.25.4.1 ＠＠ -37,6 +37,7 ＠＠ #include "device.h" #include "elhash.h" +#include "events.h" #include "faces.h" #include "frame-impl.h" #include "gui.h" ＠＠ -254,7 +255,7 ＠＠ glyph = get_toolbar_button_glyph (w, tb); if (GLYPHP (glyph)) - instance = glyph_image_instance (glyph, window, + instance = glyph_image_instance (glyph, window, button, ERROR_ME_DEBUG_WARN, 1); else instance = Qnil; ＠＠ -621,7 +622,7 ＠＠ WORD id) { /* Try to map the command id through the proper hash table */ - Lisp_Object button, data, fn, arg, frame; + Lisp_Object button; button = Fgethash (make_int (id), FRAME_MSWINDOWS_TOOLBAR_HASH_TABLE (f), Qnil); ＠＠ -629,16 +630,12 ＠＠ if (NILP (button)) return Qnil; - data = XTOOLBAR_BUTTON (button)->callback; + assert (!UNBOUNDP (XTOOLBAR_BUTTON (button)->callback)); - /* #### ? */ - if (UNBOUNDP (data)) - return Qnil; - - /* Ok, this is our one. Enqueue it. */ - get_gui_callback (data, &fn, &arg); - frame = wrap_frame (f); - mswindows_enqueue_misc_user_event (frame, fn, arg); + /* #### drat it! We don't currently have any access to the caption of + the toolbar button! */ + enqueue_activate_event (ACTIVATE_TOOLBAR_SELECTION, wrap_frame (f), + /* #### */ Qnil, XTOOLBAR_BUTTON (button)->callback); return Qt; } 1.34.4.1 +22 -25 XEmacs/xemacs/src/toolbar.c Index: toolbar.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/toolbar.c,v retrieving revision 1.34 retrieving revision 1.34.4.1 diff -u -r1.34 -r1.34.4.1 --- toolbar.c 2005/01/24 23:34:12 1.34 +++ toolbar.c 2005/02/16 00:43:59 1.34.4.1 ＠＠ -1360,34 +1360,11 ＠＠ void vars_of_toolbar (void) { + Lisp_Object fb; + staticpro (&Vdefault_toolbar_position); Vdefault_toolbar_position = Qtop; -#ifdef HAVE_WINDOW_SYSTEM - Fprovide (Qtoolbar); -#endif -} - -void -specifier_type_create_toolbar (void) -{ - INITIALIZE_SPECIFIER_TYPE (toolbar, "toolbar", "toolbar-specifier-p"); - - SPECIFIER_HAS_METHOD (toolbar, validate); - SPECIFIER_HAS_METHOD (toolbar, after_change); -} - -void -reinit_specifier_type_create_toolbar (void) -{ - REINITIALIZE_SPECIFIER_TYPE (toolbar); -} - -void -specifier_vars_of_toolbar (void) -{ - Lisp_Object fb; - DEFVAR_SPECIFIER ("default-toolbar", &Vdefault_toolbar /* Specifier for a fallback toolbar. Use `set-specifier' to change this. ＠＠ -1990,4 +1967,24 ＠＠ 0, 0, 0); set_specifier_fallback (Vtoolbar_buttons_captioned_p, list1 (Fcons (Qnil, Qt))); + +#ifdef HAVE_WINDOW_SYSTEM + Fprovide (Qtoolbar); +#endif } + +void +specifier_type_create_toolbar (void) +{ + INITIALIZE_SPECIFIER_TYPE (toolbar, "toolbar", "toolbar-specifier-p"); + + SPECIFIER_HAS_METHOD (toolbar, validate); + SPECIFIER_HAS_METHOD (toolbar, after_change); +} + +void +reinit_specifier_type_create_toolbar (void) +{ + REINITIALIZE_SPECIFIER_TYPE (toolbar); +} + 1.32.6.1 +2 -2 XEmacs/xemacs/src/tooltalk.c Index: tooltalk.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/tooltalk.c,v retrieving revision 1.32 retrieving revision 1.32.6.1 diff -u -r1.32 -r1.32.6.1 --- tooltalk.c 2004/09/20 19:20:04 1.32 +++ tooltalk.c 2005/02/16 00:44:00 1.32.6.1 ＠＠ -1480,7 +1480,7 ＠＠ staticpro (&Vtooltalk_message_gcpro); staticpro (&Vtooltalk_pattern_gcpro); Vtooltalk_message_gcpro = - make_lisp_hash_table (10, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (10, hash_table_non_weak, HASH_TABLE_EQ); Vtooltalk_pattern_gcpro = - make_lisp_hash_table (10, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + make_lisp_hash_table (10, hash_table_non_weak, HASH_TABLE_EQ); } 1.8.6.1 +19 -1 XEmacs/xemacs/src/ui-byhand.c Index: ui-byhand.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/ui-byhand.c,v retrieving revision 1.8 retrieving revision 1.8.6.1 diff -u -r1.8 -r1.8.6.1 --- ui-byhand.c 2004/11/04 23:06:56 1.8 +++ ui-byhand.c 2005/02/16 00:44:00 1.8.6.1 ＠＠ -9,6 +9,8 ＠＠ William M. Perry 5/8/00 */ +/* !!#### This file is entirely non-Mule-ized. Major crash city. */ + #include "gui.h" DEFUN ("gtk-box-query-child-packing", Fgtk_box_query_child_packing, 2, 2,0, /* ＠＠ -303,6 +305,7 ＠＠ wtaerror ("Object is not a GtkEditable", obj); } + /* !!#### Warning non-Mule-ized. */ gtk_editable_insert_text (GTK_EDITABLE (XGTK_OBJECT (obj)->object), (char *) XSTRING_DATA (string), XSTRING_LENGTH (string), ＠＠ -477,8 +480,14 ＠＠ lisp_user_data = XCAR (callback); callback = XCDR (callback); + + /* #### See comment below in #error */ + if (!NILP (lisp_user_data)) + callback = list3 (Qfuncall, list2 (Qquote, callback), + list2 (Qquote, lisp_user_data)); - signal_special_gtk_user_event (Qnil, callback, lisp_user_data); + gtk_enqueue_activate_event (ACTIVATE_TOOLBAR_SELECTION, need a frame here, + need the toolbar caption here, callback); } static Lisp_Object ＠＠ -525,6 +534,7 ＠＠ if (NILP (position)) { + /* !!#### Warning non-Mule-ized. */ w = (NILP (prepend_p) ? gtk_toolbar_append_item : gtk_toolbar_prepend_item) (GTK_TOOLBAR (XGTK_OBJECT (toolbar)->object), (char*) XSTRING_DATA (text), ＠＠ -536,6 +546,7 ＠＠ } else { + /* !!#### Warning non-Mule-ized. */ w = gtk_toolbar_insert_item (GTK_TOOLBAR (XGTK_OBJECT (toolbar)->object), (char*) XSTRING_DATA (text), (char*) XSTRING_DATA (tooltip_text), ＠＠ -549,6 +560,13 ＠＠ return (w ? build_gtk_object (GTK_OBJECT (w)) : Qnil); } + +#error Urk! This needs to follow the generic UI, not make up its own! +#error Granted, the generic UI has problems, but then make a better generic one. +#error The standard UI has only a callback, not both callback and data. +#error The generic callback, if declared (interactive "e"), can retrieve its +#error activating event, with lots of stuff there. No way to do that in this +#error API. --ben DEFUN ("gtk-toolbar-append-item", Fgtk_toolbar_append_item, 6, 7, 0, /* Appends a new button to the given toolbar. 1.22.4.1 +22 -12 XEmacs/xemacs/src/ui-gtk.c Index: ui-gtk.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/ui-gtk.c,v retrieving revision 1.22 retrieving revision 1.22.4.1 diff -u -r1.22 -r1.22.4.1 --- ui-gtk.c 2005/01/26 10:22:25 1.22 +++ ui-gtk.c 2005/02/16 00:44:01 1.22.4.1 ＠＠ -7,6 +7,8 ＠＠ ** */ +/* !!#### This file is entirely non-Mule-ized. Major crash city. */ + #include <config.h> #include "lisp.h" ＠＠ -82,6 +84,7 ＠＠ dll = Fexpand_file_name (dll, Qnil); /* Check if we have already opened it first */ + /* !!#### Warning non-Mule-ized. */ h = g_hash_table_lookup (dll_cache, XSTRING_DATA (dll)); if (!h) ＠＠ -90,6 +93,7 ＠＠ if (h) { + /* !!#### Warning non-Mule-ized. */ g_hash_table_insert (dll_cache, qxestrdup (XSTRING_DATA (dll)), h); } else ＠＠ -330,16 +334,6 ＠＠ #define MANY_ARGS #endif -typedef void (*pfv)(); -typedef GtkObject * (*__OBJECT_fn) (MANY_ARGS); -typedef gint (*__INT_fn) (MANY_ARGS); -typedef void (*__NONE_fn) (MANY_ARGS); -typedef gchar * (*__STRING_fn) (MANY_ARGS); -typedef gboolean (*__BOOL_fn) (MANY_ARGS); -typedef gfloat (*__FLOAT_fn) (MANY_ARGS); -typedef void * (*__POINTER_fn) (MANY_ARGS); -typedef GList * (*__LIST_fn) (MANY_ARGS); - /* An auto-generated file of marshalling functions. */ #include "emacs-marshals.c" #undef MANY_ARGS ＠＠ -522,6 +516,7 ＠＠ initialize_dll_cache (); xemacs_init_gtk_classes (); + /* !!#### Warning non-Mule-ized. */ arg.type = gtk_type_from_name ((char *) XSTRING_DATA (type)); if (arg.type == GTK_TYPE_INVALID) ＠＠ -534,6 +529,7 ＠＠ struct __dll_mapper_closure closure; closure.func = dll_variable; + /* !!#### Warning non-Mule-ized. */ closure.obj_name = XSTRING_DATA (name); closure.storage = &var; ＠＠ -577,6 +573,7 ＠＠ struct __dll_mapper_closure closure; closure.func = dll_function; + /* !!#### Warning non-Mule-ized. */ closure.obj_name = XSTRING_DATA (name); closure.storage = (void **) &name_func; ＠＠ -609,6 +606,7 ＠＠ type = Fsymbol_name (elt); + /* !!#### Warning non-Mule-ized. */ the_type = gtk_type_from_name ((char *) XSTRING_DATA (type)); if (the_type == GTK_TYPE_INVALID) ＠＠ -637,6 +635,7 ＠＠ } rettype = Fsymbol_name (rettype); + /* !!#### Warning non-Mule-ized. */ data->return_type = gtk_type_from_name ((char *) XSTRING_DATA (rettype)); if (data->return_type == GTK_TYPE_INVALID) ＠＠ -649,6 +648,7 ＠＠ marshaller = concat3 (type_to_marshaller_type (data->return_type), build_string ("_"), marshaller); marshaller = concat2 (build_string ("emacs_gtk_marshal_"), marshaller); + /* !!#### Warning non-Mule-ized. */ marshaller_func = (ffi_marshalling_function) find_marshaller ((char *) XSTRING_DATA (marshaller)); if (!marshaller_func) ＠＠ -803,6 +803,7 ＠＠ prop_name = Fsymbol_name (prop); + /* !!#### Warning non-Mule-ized. */ args[0].name = (char *) XSTRING_DATA (prop_name); err = gtk_object_arg_get_info (GTK_OBJECT_TYPE (XGTK_OBJECT (obj)->object), ＠＠ -864,6 +865,7 ＠＠ prop_name = Fsymbol_name (prop); + /* !!#### Warning non-Mule-ized. */ args[0].name = (char *) XSTRING_DATA (prop_name); err = gtk_object_arg_get_info (GTK_OBJECT_TYPE (XGTK_OBJECT (obj)->object), ＠＠ -1082,6 +1084,7 ＠＠ gcpro_popup_callbacks (id, func); + /* !!#### Warning non-Mule-ized. */ gtk_signal_connect_full (XGTK_OBJECT (obj)->object, (char *) XSTRING_DATA (name), NULL, __internal_callback_marshal, LISP_TO_VOID (func), __internal_callback_destroy, c_object_signal, c_after); ＠＠ -1204,6 +1207,7 ＠＠ CHECK_STRING (type); + /* !!#### Warning non-Mule-ized. */ t = gtk_type_from_name ((char *) XSTRING_DATA (type)); if (t == GTK_TYPE_INVALID) ＠＠ -1241,7 +1245,8 ＠＠ if (STRINGP (type)) { - t = gtk_type_from_name ((gchar*) XSTRING_DATA (type)); + /* !!#### Warning non-Mule-ized. */ + t = gtk_type_from_name ((gchar *) XSTRING_DATA (type)); if (t == GTK_TYPE_INVALID) { invalid_argument ("Not a GTK type", type); ＠＠ -1600,6 +1605,7 ＠＠ else { CHECK_STRING (obj); + /* !!#### Warning non-Mule-ized. */ GTK_VALUE_STRING (*arg) = (char *) XSTRING_DATA (obj); } break; ＠＠ -1635,7 +1641,11 ＠＠ { Lisp_Object window = Fselected_window (Qnil); Lisp_Object instance = - glyph_image_instance (obj, window, ERROR_ME_DEBUG_WARN, 1); +#error Qnil below ought to be the MATCHSPEC (i.e. governing object of +#error the glyph, see glyphs.c). This is necessary for subcontrols. +#error with Qnil, we will not get the subcontrol actually used by redisplay. + glyph_image_instance (obj, window, Qnil, + ERROR_ME_DEBUG_WARN, 1); struct Lisp_Image_Instance *p = XIMAGE_INSTANCE (instance); switch (XIMAGE_INSTANCE_TYPE (instance)) 1.3.16.1 +1 -0 XEmacs/xemacs/src/widget.c Index: widget.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/widget.c,v retrieving revision 1.3 retrieving revision 1.3.16.1 diff -u -r1.3 -r1.3.16.1 --- widget.c 2001/05/24 07:51:33 1.3 +++ widget.c 2005/02/16 00:44:01 1.3.16.1 ＠＠ -92,6 +92,7 ＠＠ Apply the value of WIDGET's PROPERTY to the widget itself. ARGS are passed as extra arguments to the function. */ + /* (widget property &rest args) */ (int nargs, Lisp_Object *args)) { /* This function can GC */ 1.83.4.1 +55 -56 XEmacs/xemacs/src/window.c Index: window.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/window.c,v retrieving revision 1.83 retrieving revision 1.83.4.1 diff -u -r1.83 -r1.83.4.1 --- window.c 2005/02/03 16:14:08 1.83 +++ window.c 2005/02/16 00:44:02 1.83.4.1 ＠＠ -1,7 +1,7 ＠＠ /* Window creation, deletion and examination for XEmacs. Copyright (C) 1985-1987, 1992-1995 Free Software Foundation, Inc. Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995, 1996, 2002 Ben Wing. + Copyright (C) 1995, 1996, 2002, 2005 Ben Wing. Copyright (C) 1996 Chuck Thompson. This file is part of XEmacs. ＠＠ -321,7 +321,7 ＠＠ static Lisp_Object make_saved_buffer_point_cache (void) { - return make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQ); + return make_lisp_hash_table (20, hash_table_key_weak, HASH_TABLE_EQ); } DEFINE_LRECORD_IMPLEMENTATION ("window", window, ＠＠ -365,7 +365,6 ＠＠ 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_image_instance_cache_hash_table (); p->line_cache_last_updated = Qzero; ＠＠ -1664,6 +1663,15 ＠＠ return make_int (decode_window (window)->pixel_width); } +DEFUN ("window-maximum-line-width", Fwindow_maximum_line_width, + 1, 1, 0, /* +Return maximum width of any line visible in WINDOW. +*/ + (window)) +{ + return make_int (decode_window (window)->max_line_len); +} + DEFUN ("window-text-area-pixel-width", Fwindow_text_area_pixel_width, 0, 1, 0, /* Return the width in pixels of the text-displaying portion of WINDOW. ＠＠ -2055,16 +2063,6 ＠＠ /* #### Here, if replacement is a vertical combination and so is its new parent, we should make replacement's children be children of that parent instead. */ - - ERROR_CHECK_SUBWINDOW_CACHE (p); -} - -static void -window_unmap_subwindows (struct window* w) -{ - assert (!NILP (w->subwindow_instance_cache)); - elisp_maphash (unmap_subwindow_instance_cache_mapper, - w->subwindow_instance_cache, (void*)1); } /* we're deleting W; set the structure of W to indicate this. */ ＠＠ -2072,24 +2070,32 ＠＠ static void mark_window_as_deleted (struct window *w) { - /* The window instance cache is going away now, so need to get the - cachels reset by redisplay. */ - MARK_FRAME_SUBWINDOWS_CHANGED (XFRAME (WINDOW_FRAME (w))); - - /* The cache is going away. If we leave unmapping to - reset_subwindow_cachels then we get in a situation where the - domain (the window) has been deleted but we still need access to - its attributes in order to unmap windows properly. Since the - subwindows are going to get GC'd anyway as a result of the domain - going away, it is safer to just unmap them all while we know the - domain is still valid. */ - ERROR_CHECK_SUBWINDOW_CACHE (w); - window_unmap_subwindows (w); + /* Old comment: + [[ It's quite likely that deleting a window will result in + subcontrols needing to be deleted also (since they are cached + per-window). So we mark them as changed, so that the cachels will + get reset by redisplay and thus deleted subcontrols can get + GC'd. ]] + + I have no idea what this comment is trying to say, and I don't + think it applies any more, but the following can't hurt. --ben */ + MARK_FRAME_SUBCONTROLS_CHANGED (XFRAME (WINDOW_FRAME (w))); + + /* It's most sensible to unmap, finalize and remove all subcontrol + instances on this window right now rather than waiting till the frame + is deleted. That way, the finalizers and other code don't have to + deal with the possibility of the governing domain being deleted. + + #### What about if the window gets undeleted by window configuration + restore? It might be more efficient to keep the subcontrols around. + */ + free_window_subcontrols (w); + /* Free the extra data structures attached to windows immediately so they don't sit around consuming excess space. They will be reinitialized by the window-configuration code as necessary. */ - finalize_window ((void *) w, 0); + finalize_window (w, 0); /* Nobody should be accessing anything in this object any more, and making them Qnil allows for better GC'ing in case a pointer ＠＠ -2120,7 +2126,6 ＠＠ w->hchild = Qnil; w->vchild = Qnil; w->parent = Qnil; - w->subwindow_instance_cache = Qnil; w->dead = 1; note_object_deleted (wrap_window (w)); ＠＠ -2203,12 +2208,6 ＠＠ par = XWINDOW (parent); MARK_FRAME_WINDOWS_STRUCTURE_CHANGED (f); - /* It's quite likely that deleting a window will result in - subwindows needing to be deleted also (since they are cached - per-window). So we mark them as changed, so that the cachels will - get reset by redisplay and thus deleted subwindows can get - GC'd. */ - MARK_FRAME_SUBWINDOWS_CHANGED (f); /* Are we trying to delete any frame's selected window? Note that we could be dealing with a non-leaf window ＠＠ -2302,9 +2301,9 ＠＠ /* Since we may be deleting combination windows, we must make sure that not only W but all its children have been marked as deleted. */ if (!NILP (w->hchild)) - delete_all_subwindows (XWINDOW (w->hchild)); + delete_all_child_windows (XWINDOW (w->hchild)); else if (!NILP (w->vchild)) - delete_all_subwindows (XWINDOW (w->vchild)); + delete_all_child_windows (XWINDOW (w->vchild)); /* Warning: mark_window_as_deleted calls window_unmap_subwindows and therefore redisplay, so it requires the mirror structure to be ＠＠ -3812,8 +3811,6 ＠＠ p->line_start_cache = Dynarr_new (line_start_cache); p->face_cachels = Dynarr_new (face_cachel); p->glyph_cachels = Dynarr_new (glyph_cachel); - p->subwindow_instance_cache = - make_image_instance_cache_hash_table (); /* Put new into window structure in place of window */ replace_window (window, new); ＠＠ -4700,8 +4697,9 ＠＠ } }  -DEFUN ("scroll-up", Fscroll_up, 0, 1, "_P", /* -Scroll text of current window up COUNT lines; or near full screen if no arg. +DEFUN ("scroll-up", Fscroll_up, 0, 2, "_P", /* +Scroll text of WINDOW up COUNT lines; or near full screen if no arg. +WINDOW defaults to the selected window if omitted. A near full screen is `next-screen-context-lines' less than a full screen. Negative COUNT means scroll downward. When calling from a program, supply an integer as argument or nil. ＠＠ -4714,14 +4712,15 ＠＠ to invoke this command, and `shifted-motion-keys-select-region' is t; see the documentation for this variable for more details. */ - (count)) + (count, window)) { - window_scroll (Fselected_window (Qnil), count, 1, ERROR_ME); + window_scroll (wrap_window (decode_window (window)), count, 1, ERROR_ME); return Qnil; } -DEFUN ("scroll-down", Fscroll_down, 0, 1, "_P", /* -Scroll text of current window down COUNT lines; or near full screen if no arg. +DEFUN ("scroll-down", Fscroll_down, 0, 2, "_P", /* +Scroll text of WINDOW down COUNT lines; or near full screen if no arg. +WINDOW defaults to the selected window if omitted. A near full screen is `next-screen-context-lines' less than a full screen. Negative COUNT means scroll upward. When calling from a program, supply a number as argument or nil. ＠＠ -4734,9 +4733,9 ＠＠ to invoke this command, and `shifted-motion-keys-select-region' is t; see the documentation for this variable for more details. */ - (count)) + (count, window)) { - window_scroll (Fselected_window (Qnil), count, -1, ERROR_ME); + window_scroll (wrap_window (decode_window (window)), count, -1, ERROR_ME); return Qnil; }  ＠＠ -5176,15 +5175,15 ＠＠ #endif /* MEMORY_USAGE_STATS */  -/* Mark all subwindows of a window as deleted. The argument - W is actually the subwindow tree of the window in question. */ +/* Mark all children of a window as deleted. The argument + W is actually the child window tree of the window in question. */ void -delete_all_subwindows (struct window *w) +delete_all_child_windows (struct window *w) { - if (!NILP (w->next)) delete_all_subwindows (XWINDOW (w->next)); - if (!NILP (w->vchild)) delete_all_subwindows (XWINDOW (w->vchild)); - if (!NILP (w->hchild)) delete_all_subwindows (XWINDOW (w->hchild)); + if (!NILP (w->next)) delete_all_child_windows (XWINDOW (w->next)); + if (!NILP (w->vchild)) delete_all_child_windows (XWINDOW (w->vchild)); + if (!NILP (w->hchild)) delete_all_child_windows (XWINDOW (w->hchild)); mark_window_as_deleted (w); } ＠＠ -5202,6 +5201,7 ＠＠ as well as the current buffer. Does not restore the value of point in current buffer. */ + /* (&rest body) */ (args)) { /* This function can GC */ ＠＠ -5424,6 +5424,7 ＠＠ DEFSUBR (Fwindow_pixel_height); DEFSUBR (Fwindow_pixel_width); DEFSUBR (Fwindow_text_area_height); + DEFSUBR (Fwindow_maximum_line_width); DEFSUBR (Fwindow_text_area_pixel_height); DEFSUBR (Fwindow_displayed_text_pixel_height); DEFSUBR (Fwindow_text_area_pixel_width); ＠＠ -5534,11 +5535,9 ＠＠ *Delete any window less than this wide. */ ); window_min_width = 10; -} -void -specifier_vars_of_window (void) -{ + /* Specifiers */ + DEFVAR_SPECIFIER ("modeline-shadow-thickness", &Vmodeline_shadow_thickness /* *How thick to draw 3D shadows around modelines. If this is set to 0, modelines will be the traditional 2D. Sizes above 1.20.6.1 +1 -1 XEmacs/xemacs/src/window.h Index: window.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/window.h,v retrieving revision 1.20 retrieving revision 1.20.6.1 diff -u -r1.20 -r1.20.6.1 --- window.h 2002/12/08 10:25:14 1.20 +++ window.h 2005/02/16 00:44:03 1.20.6.1 ＠＠ -140,7 +140,7 ＠＠ int window_left_gutter_width (struct window *w, int modeline); int window_right_gutter_width (struct window *w, int modeline); -void delete_all_subwindows (struct window *w); +void delete_all_child_windows (struct window *w); void set_window_pixheight (Lisp_Object window, int pixheight, int nodelete); void set_window_pixwidth (Lisp_Object window, int pixwidth, 1.11.6.1 +4 -9 XEmacs/xemacs/src/winslots.h Index: winslots.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/winslots.h,v retrieving revision 1.11 retrieving revision 1.11.6.1 diff -u -r1.11 -r1.11.6.1 --- winslots.h 2003/02/09 09:33:48 1.11 +++ winslots.h 2005/02/16 00:44:04 1.11.6.1 ＠＠ -153,16 +153,11 ＠＠ /* buf.face_change as of last time display completed */ WINDOW_SLOT_ARRAY (last_facechange, 3) - /* 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. */ - WINDOW_SLOT (subwindow_instance_cache) - WINDOW_SLOT (line_cache_last_updated) + + /* If redisplay in this window goes beyond this buffer position, + must run the redisplay-end-trigger-functions. */ + WINDOW_SLOT (redisplay_end_trigger) /*** Non-specifier vars of window and window config ***/ No revision No revision 1.1.2.1 +682 -0 XEmacs/xemacs/src/Attic/redisplay-xlike.c Index: redisplay-xlike.c =================================================================== RCS file: redisplay-xlike.c diff -N redisplay-xlike.c --- /dev/null Wed Feb 16 01:47:06 2005 +++ /tmp/cvsAAAapa4gk Wed Feb 16 01:47:21 2005 ＠＠ -0,0 +1,682 ＠＠ +/* Redisplay routines common to X and Gtk. + Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. + Copyright (C) 1994 Lucid, Inc. + Copyright (C) 1995 Sun Microsystems, Inc. + Copyright (C) 2002, 2005 Ben Wing. + +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. */ + +/* Factored out from redisplay-x.c/redisplay-gtk.c June 1, 2002 by Ben Wing */ + +#include <config.h> +#include "lisp.h" + +#include "buffer.h" +#include "console-impl.h" +#include "debug.h" +#include "device-impl.h" +#include "faces.h" +#include "file-coding.h" +#include "frame-impl.h" +#include "glyphs.h" +#include "gutter.h" +#include "objects-impl.h" +#include "redisplay.h" +#include "sysdep.h" +#include "window-impl.h" + +#ifdef MULE +#include "mule-ccl.h" +#endif + +DEFINE_CONSOLE_TYPE (xlike); + +#define EOL_CURSOR_WIDTH 5 + +static void xlike_clear_frame_windows (Lisp_Object window); + +/* Separate out the text in DYN into a series of textual runs of a + particular charset. Also convert the characters as necessary into + the format needed by XDrawImageString(), XDrawImageString16(), et + al. (This means converting to one or two byte format, possibly + tweaking the high bits, and possibly running a CCL program.) You + must pre-allocate the space used and pass it in. (This is done so + you can alloca() the space.) You need to allocate (2 * len) bytes + of TEXT_STORAGE and (len * sizeof (struct textual_run)) bytes of + RUN_STORAGE, where LEN is the length of the dynarr. + + Returns the number of runs actually used. */ + +static int +separate_textual_runs (unsigned char *text_storage, + struct textual_run *run_storage, + const Ichar *str, Charcount len) +{ + Lisp_Object prev_charset = Qunbound; /* not Qnil because that is a + possible valid charset when + MULE is not defined */ + int runs_so_far = 0; + int i; +#ifdef MULE + struct ccl_program char_converter; + int need_ccl_conversion = 0; +#endif + + for (i = 0; i < len; i++) + { + Ichar ch = str[i]; + Lisp_Object charset; + int byte1, byte2; + int dimension; + int graphic; + + BREAKUP_ICHAR (ch, charset, byte1, byte2); + dimension = XCHARSET_DIMENSION (charset); + graphic = XCHARSET_GRAPHIC (charset); + + if (!EQ (charset, prev_charset)) + { + run_storage[runs_so_far].ptr = text_storage; + run_storage[runs_so_far].charset = charset; + run_storage[runs_so_far].dimension = dimension; + + if (runs_so_far) + { + run_storage[runs_so_far - 1].len = + text_storage - run_storage[runs_so_far - 1].ptr; + if (run_storage[runs_so_far - 1].dimension == 2) + run_storage[runs_so_far - 1].len >>= 1; + } + runs_so_far++; + prev_charset = charset; +#ifdef MULE + { + Lisp_Object ccl_prog = XCHARSET_CCL_PROGRAM (charset); + if ((!NILP (ccl_prog)) + && (setup_ccl_program (&char_converter, ccl_prog) >= 0)) + need_ccl_conversion = 1; + } +#endif + } + + if (graphic == 0) + { + byte1 &= 0x7F; + byte2 &= 0x7F; + } + else if (graphic == 1) + { + byte1 |= 0x80; + byte2 |= 0x80; + } +#ifdef MULE + if (need_ccl_conversion) + { + char_converter.reg[0] = XCHARSET_ID (charset); + char_converter.reg[1] = byte1; + char_converter.reg[2] = byte2; + ccl_driver (&char_converter, 0, 0, 0, 0, CCL_MODE_ENCODING); + byte1 = char_converter.reg[1]; + byte2 = char_converter.reg[2]; + } +#endif + *text_storage++ = (unsigned char) byte1; + if (dimension == 2) + *text_storage++ = (unsigned char) byte2; + } + + if (runs_so_far) + { + run_storage[runs_so_far - 1].len = + text_storage - run_storage[runs_so_far - 1].ptr; + if (run_storage[runs_so_far - 1].dimension == 2) + run_storage[runs_so_far - 1].len >>= 1; + } + + return runs_so_far; +} + +static int +xlike_text_width (struct frame *f, struct face_cachel *cachel, + const Ichar *str, Charcount len) +{ + int width_so_far = 0; + unsigned char *text_storage = (unsigned char *) ALLOCA (2 * len); + struct textual_run *runs = alloca_array (struct textual_run, len); + int nruns; + int i; + + nruns = separate_textual_runs (text_storage, runs, str, len); + + for (i = 0; i < nruns; i++) + width_so_far += FRAMEMETH (f, text_width_single_run, (cachel, runs + i)); + + return width_so_far; +} + +static int +xlike_eol_cursor_width (void) +{ + return EOL_CURSOR_WIDTH; +} + +/* xlike_output_string_1(): + + Parameters same as for output_string method (see console.h), except: + + BUF Dynamic array of Ichars specifying what is actually to be + drawn. May be NULL (e.g. when CURSOR set), in which case ... + CURSOR_CH ... will be the single character to draw. (Used when a cursor + is being output, but CURSOR may or may not be set, depending + on the type of cursor -- only block cursors will have CURSOR + set, and for the rest, x_output_cursor() draws the cursor. + CURSOR If non-zero, draw the text using the foreground and background + of the cursor (i.e. make a block cursor). Bar/non-focus/blank + cursors handled elsewhere. +*/ + +static void +xlike_output_string_1 (struct window *w, struct display_line *dl, + Ichar_dynarr *buf, Ichar cursor_ch, int xpos, + int xoffset, int clip_start, int width, + face_index findex, int cursor) +{ + /* General variables */ + struct frame *f = XFRAME (w->frame); + struct device *d = XDEVICE (f->device); + Lisp_Object device; + Lisp_Object window; + int clip_end; + struct face_cachel *cursor_cachel = 0; + + /* Text-related variables */ + Lisp_Object bg_pmap; + void *bgc, *gc; + int height; + int len = buf ? Dynarr_length (buf) : 1; + unsigned char *text_storage = (unsigned char *) ALLOCA (2 * len); + struct textual_run *runs = alloca_array (struct textual_run, len); + int nruns; + int i; + struct face_cachel *cachel = WINDOW_FACE_CACHEL (w, findex); + + device = wrap_device (d); + window = wrap_window (w); + + if (width < 0) + { + if (buf) + width = DEVMETH (d, text_width, (f, cachel, Dynarr_atp (buf, 0), + Dynarr_length (buf))); + else + width = DEVMETH (d, text_width, (f, cachel, &cursor_ch, 1)); + } + height = DISPLAY_LINE_HEIGHT (dl); + + /* Regularize the variables passed in. */ + + clip_end = xpos + width; + xpos -= xoffset; + + /* make sure the area we are about to display is subcontrol free. */ + redisplay_unmap_subcontrols (f, clip_start, DISPLAY_LINE_YPOS (dl), + clip_end - clip_start, + DISPLAY_LINE_HEIGHT (dl), Qnil); + + if (buf) + nruns = separate_textual_runs (text_storage, runs, Dynarr_atp (buf, 0), + Dynarr_length (buf)); + else + nruns = separate_textual_runs (text_storage, runs, &cursor_ch, 1); + + if (cursor) + { + /* These have to be in separate statements in order to avoid a + compiler bug. */ + face_index sucks = get_builtin_face_cache_index (w, Vtext_cursor_face); + cursor_cachel = WINDOW_FACE_CACHEL (w, sucks); + + /* We have to reset this since any call to WINDOW_FACE_CACHEL + may cause the cache to resize and any pointers to it to + become invalid. */ + cachel = WINDOW_FACE_CACHEL (w, findex); + } + + bg_pmap = cachel->background_pixmap; + if (!IMAGE_INSTANCEP (bg_pmap) + || !IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (bg_pmap))) + bg_pmap = Qnil; + + if (cursor || NILP (bg_pmap)) + bgc = 0; + else + bgc = DEVMETH (d, get_gc, (d, Qnil, cachel->foreground, cachel->background, + bg_pmap, Qnil)); + + if (bgc) + DEVMETH (d, draw_rectangle, (f, bgc, 1, clip_start, + DISPLAY_LINE_YPOS (dl), clip_end - clip_start, + height)); + + for (i = 0; i < nruns; i++) + { + Lisp_Object font = FACE_CACHEL_FONT (cachel, runs[i].charset); + Lisp_Font_Instance *fi = XFONT_INSTANCE (font); + int this_width; + int need_clipping; + + if (EQ (font, Vthe_null_font_instance)) + continue; + + this_width = DEVMETH (d, text_width_single_run, (cachel, runs + i)); + need_clipping = (dl->clip || clip_start > xpos || + clip_end < xpos + this_width); + + /* XDrawImageString/gdk_draw_text_image only clears the area equal to + the height of the given font. It is possible that a font is being + displayed on a line taller than it is, so this would cause us to + fail to clear some areas. */ + if ((int) fi->height < (int) (height + dl->clip + dl->top_clip)) + { + int clear_start = max (xpos, clip_start); + int clear_end = min (xpos + this_width, clip_end); + + redisplay_clear_region (window, findex, clear_start, + DISPLAY_LINE_YPOS (dl), + clear_end - clear_start, + height); + } + + if (cursor && cursor_cachel) + gc = DEVMETH (d, get_gc, (d, font, cursor_cachel->foreground, + cursor_cachel->background, Qnil, Qnil)); + else + gc = DEVMETH (d, get_gc, (d, font, cachel->foreground, + cachel->background, + cachel->dim ? Qdim : Qnil, Qnil)); + + if (need_clipping) + DEVMETH (d, set_clip_rectangle, (f, gc, clip_start, + DISPLAY_LINE_YPOS (dl), + clip_end - clip_start, height)); + + DEVMETH (d, draw_text, (f, font, gc, !!bgc, xpos, + dl->ypos, runs[i].ptr, runs[i].len, + runs[i].dimension)); + + /* We draw underlines in the same color as the text. */ + if (cachel->underline) + { + int upos, uthick; + + if (!DEVMETH (d, get_font_property, + (font, XLIKE_UNDERLINE_POSITION, &upos))) + upos = dl->descent / 2; + if (!DEVMETH (d, get_font_property, + (font, XLIKE_UNDERLINE_THICKNESS, &uthick))) + uthick = 1; + + if (dl->ypos + upos < dl->ypos + dl->descent - dl->clip) + { + if (dl->ypos + upos + uthick > dl->ypos + dl->descent - dl->clip) + uthick = dl->descent - dl->clip - upos; + + if (uthick == 1) + DEVMETH (d, draw_line, + (f, gc, xpos, dl->ypos + upos, + xpos + this_width, dl->ypos + upos)); + else if (uthick > 1) + DEVMETH (d, draw_rectangle, + (f, gc, 1, xpos, dl->ypos + upos, this_width, + uthick)); + } + } + + if (cachel->strikethru) + { + int ascent, descent, upos, uthick; + + if (!DEVMETH (d, get_font_property, + (font, XLIKE_STRIKEOUT_ASCENT, &ascent))) + ascent = 0; /* Should not happen! Should return font ascent. */ + if (!DEVMETH (d, get_font_property, + (font, XLIKE_STRIKEOUT_DESCENT, &descent))) + descent = 0; /* Same here. */ + if (!DEVMETH (d, get_font_property, + (font, XLIKE_UNDERLINE_THICKNESS, &uthick))) + uthick = 1; + + upos = ascent - ((ascent + descent) / 2) + 1; + + /* Generally, upos will be positive (above the baseline), + so subtract */ + if (dl->ypos - upos < dl->ypos + dl->descent - dl->clip) + { + if (dl->ypos - upos + uthick > dl->ypos + dl->descent - dl->clip) + uthick = dl->descent - dl->clip + upos; + + if (uthick == 1) + DEVMETH (d, draw_line, (f, gc, xpos, dl->ypos - upos, + xpos + this_width, dl->ypos - upos)); + else if (uthick > 1) + DEVMETH (d, draw_rectangle, + (f, gc, 1, xpos, dl->ypos + upos, this_width, + uthick)); + } + } + + /* Restore the GC */ + if (need_clipping) + DEVMETH (d, unset_clip_rectangle, (f, gc)); + + xpos += this_width; + } +} + +static void +xlike_output_string (struct window *w, struct display_line *dl, + Ichar_dynarr *buf, int xpos, int xoffset, + int clip_start, int width, face_index findex) +{ + xlike_output_string_1 (w, dl, buf, 0, xpos, xoffset, clip_start, + width, findex, 0); +} + +static void +xlike_output_cursor (struct window *w, struct display_line *dl, int xpos, + int width, face_index findex, Ichar ch, int image_p) +{ + struct frame *f = XFRAME (w->frame); + struct device *d = XDEVICE (f->device); + int focus = EQ (w->frame, DEVICE_FRAME_WITH_FOCUS_REAL (d)); + Lisp_Object bar_cursor_value = symbol_value_in_buffer (Qbar_cursor, + WINDOW_BUFFER (w)); + void *gc; + int real_char_p = ch >= 0; + int dlheight = DISPLAY_LINE_HEIGHT (dl); + int dlypos = DISPLAY_LINE_YPOS (dl); + + if (focus) + DEVMETH (d, set_spot_location, (f, xpos - 2, dl->ypos + dl->descent - 2)); + + if (real_char_p) + /* Draw character, maybe with block cursor over it. */ + xlike_output_string_1 (w, dl, 0, ch, xpos, 0, xpos, width, findex, + NILP (bar_cursor_value) && focus); + else + { + redisplay_unmap_subcontrols (f, xpos, dlypos, width, dlheight, Qnil); + redisplay_clear_region (wrap_window (w), findex, xpos, dlypos, width, + dlheight); + } + + if (real_char_p && NILP (bar_cursor_value) && focus) + return; /* That's all, folks */ + else + { + int tmp_height, tmp_y; + int bar_width = EQ (bar_cursor_value, Qt) ? 1 : 2; + face_index sucks = get_builtin_face_cache_index (w, Vtext_cursor_face); + struct face_cachel *cursor_cachel = WINDOW_FACE_CACHEL (w, sucks); + struct face_cachel *cachel = + WINDOW_FACE_CACHEL (w, real_char_p ? + findex : + get_builtin_face_cache_index (w, Vdefault_face)); + Lisp_Font_Instance *fi = + XFONT_INSTANCE (FACE_CACHEL_FONT + (cachel, real_char_p ? ichar_charset (ch) : + Vcharset_ascii)); + int ascent = fi->ascent; + int height = fi->height; + + gc = DEVMETH (d, get_gc, + (d, Qnil, cursor_cachel->background, Qnil, Qnil, + !NILP (bar_cursor_value) ? make_int (bar_width) : Qnil)); + + tmp_y = dl->ypos - ascent; + tmp_height = height; + if (tmp_y + tmp_height > (int) (dlypos + dlheight)) + { + tmp_y = dlypos + dlheight - tmp_height; + if (tmp_y < (int) dlypos) + tmp_y = dlypos; + tmp_height = dlypos + dlheight - tmp_y; + } + + if (NILP (bar_cursor_value)) + DEVMETH (d, draw_rectangle, + (f, gc, focus, xpos, tmp_y, width, tmp_height)); + else if (focus) + DEVMETH (d, draw_line, (f, gc, xpos + bar_width - 1, tmp_y, + xpos + bar_width - 1, tmp_y + tmp_height - 1)); + } +} + +static void +xlike_output_blank (struct window *w, struct display_line *dl, struct rune *rb, + int start_pixpos) +{ + struct frame *f = XFRAME (w->frame); + struct device *d = XDEVICE (f->device); + Lisp_Object bg_pmap; + void *gc; + + int x = rb->xpos; + int y = DISPLAY_LINE_YPOS (dl); + int width = rb->width; + int height = DISPLAY_LINE_HEIGHT (dl); + + /* Unmap all subcontrols in the area we are going to blank. */ + redisplay_unmap_subcontrols (f, x, y, width, height, Qnil); + + if (start_pixpos > x) + { + if (start_pixpos >= (x + width)) + return; + else + { + width -= (start_pixpos - x); + x = start_pixpos; + } + } + + bg_pmap = WINDOW_FACE_CACHEL_BACKGROUND_PIXMAP (w, rb->findex); + if (!IMAGE_INSTANCEP (bg_pmap) + || !IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (bg_pmap))) + bg_pmap = Qnil; + + if (NILP (bg_pmap)) + gc = DEVMETH (d, get_gc, + (d, Qnil, WINDOW_FACE_CACHEL_BACKGROUND (w, rb->findex), + Qnil, Qnil, Qnil)); + else + gc = DEVMETH (d, get_gc, + (d, Qnil, WINDOW_FACE_CACHEL_FOREGROUND (w, rb->findex), + WINDOW_FACE_CACHEL_BACKGROUND (w, rb->findex), bg_pmap, + Qnil)); + + DEVMETH (d, draw_rectangle, (f, gc, 1, x, y, width, height)); +} + +static void +xlike_output_hline (struct window *w, struct display_line *dl, + struct rune *rb) +{ + struct frame *f = XFRAME (w->frame); + struct device *d = XDEVICE (f->device); + void *gc; + + int x = rb->xpos; + int width = rb->width; + int height = DISPLAY_LINE_HEIGHT (dl); + int ypos1, ypos2, ypos3, ypos4; + + ypos1 = DISPLAY_LINE_YPOS (dl); + ypos2 = ypos1 + rb->object.hline.yoffset; + ypos3 = ypos2 + rb->object.hline.thickness; + ypos4 = dl->ypos + dl->descent - dl->clip; + + /* First clear the area not covered by the line. */ + if (height - rb->object.hline.thickness > 0) + { + gc = DEVMETH (d, get_gc, + (d, Qnil, WINDOW_FACE_CACHEL_FOREGROUND (w, rb->findex), + Qnil, Qnil, Qnil)); + + if (ypos2 - ypos1 > 0) + DEVMETH (d, draw_rectangle, + (f, gc, 1, x, ypos1, width, ypos2 - ypos1)); + if (ypos4 - ypos3 > 0) + DEVMETH (d, draw_rectangle, + (f, gc, 1, x, ypos3, width, ypos4 - ypos3)); + } + + /* Now draw the line. */ + if (HAS_DEVMETH_P (d, draw_hline)) + DEVMETH (d, draw_hline, (f, x, x + width, ypos2, + rb->object.hline.thickness)); + else + { + /* The hard way. */ + gc = DEVMETH (d, get_gc, + (d, Qnil, WINDOW_FACE_CACHEL_BACKGROUND (w, rb->findex), + Qnil, Qnil, Qnil)); + + if (ypos2 < ypos1) + ypos2 = ypos1; + if (ypos3 > ypos4) + ypos3 = ypos4; + + if (ypos3 - ypos2 > 0) + DEVMETH (d, draw_rectangle, + (f, gc, 1, x, ypos2, width, ypos3 - ypos2)); + } +} + +static void +xlike_clear_region (Lisp_Object locale, struct device *d, struct frame *f, + face_index findex, int x, int y, + int width, int height, Lisp_Object fcolor, + Lisp_Object bcolor, Lisp_Object background_pixmap) +{ + void *gc = 0; + + if (!UNBOUNDP (background_pixmap)) + gc = DEVMETH (d, get_gc, (d, Qnil, fcolor, bcolor, background_pixmap, + Qnil)); + + if (gc) + DEVMETH (d, draw_rectangle, (f, gc, 1, x, y, width, height)); + else + DEVMETH (d, clear_area, (f, x, y, width, height)); +} + +static void +xlike_clear_frame_window (Lisp_Object window) +{ + struct window *w = XWINDOW (window); + + if (!NILP (w->vchild)) + { + xlike_clear_frame_windows (w->vchild); + return; + } + + if (!NILP (w->hchild)) + { + xlike_clear_frame_windows (w->hchild); + return; + } + + redisplay_clear_to_window_end (w, WINDOW_TEXT_TOP (w), + WINDOW_TEXT_BOTTOM (w)); +} + +static void +xlike_clear_frame_windows (Lisp_Object window) +{ + for (; !NILP (window); window = XWINDOW (window)->next) + xlike_clear_frame_window (window); +} + +static void +xlike_clear_frame (struct frame *f) +{ + int x, y, width, height; + Lisp_Object frame; + + x = FRAME_LEFT_BORDER_START (f); + width = (FRAME_PIXWIDTH (f) - FRAME_REAL_LEFT_TOOLBAR_WIDTH (f) - + FRAME_REAL_RIGHT_TOOLBAR_WIDTH (f) - + 2 * FRAME_REAL_LEFT_TOOLBAR_BORDER_WIDTH (f) - + 2 * FRAME_REAL_RIGHT_TOOLBAR_BORDER_WIDTH (f)); + /* #### This adjustment by 1 should be being done in the macros. + There is some small differences between when the menubar is on + and off that we still need to deal with. */ + y = FRAME_TOP_BORDER_START (f) - 1; + height = (FRAME_PIXHEIGHT (f) - FRAME_REAL_TOP_TOOLBAR_HEIGHT (f) - + FRAME_REAL_BOTTOM_TOOLBAR_HEIGHT (f) - + 2 * FRAME_REAL_TOP_TOOLBAR_BORDER_WIDTH (f) - + 2 * FRAME_REAL_BOTTOM_TOOLBAR_BORDER_WIDTH (f)) + 1; + + FRAMEMETH (f, clear_area, (f, x, y, width, height)); + frame = wrap_frame (f); + + if (!UNBOUNDP (FACE_BACKGROUND_PIXMAP (Vdefault_face, frame)) + || !UNBOUNDP (FACE_BACKGROUND_PIXMAP (Vleft_margin_face, frame)) + || !UNBOUNDP (FACE_BACKGROUND_PIXMAP (Vright_margin_face, frame))) + { + xlike_clear_frame_windows (f->root_window); + } + + MAYBE_FRAMEMETH (f, frame_output_end, (f)); +} + + + +/************************************************************************/ +/* initialization */ +/************************************************************************/ + +void +console_type_create_xlike (void) +{ + INITIALIZE_PSEUDO_CONSOLE_TYPE (xlike); +} + +void +reinit_console_type_create_xlike (void) +{ + REINITIALIZE_CONSOLE_TYPE (xlike); +} + +void +console_type_create_redisplay_xlike (void) +{ + /* redisplay methods */ + CONSOLE_HAS_METHOD (xlike, text_width); + CONSOLE_HAS_METHOD (xlike, output_string); + CONSOLE_HAS_METHOD (xlike, output_hline); + CONSOLE_HAS_METHOD (xlike, output_blank); + CONSOLE_HAS_METHOD (xlike, output_cursor); + CONSOLE_HAS_METHOD (xlike, eol_cursor_width); + CONSOLE_HAS_METHOD (xlike, clear_region); + CONSOLE_HAS_METHOD (xlike, clear_frame); +} No revision No revision 1.2.24.1 +13 -4 XEmacs/xemacs/tests/glyph-test.el Index: glyph-test.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/tests/glyph-test.el,v retrieving revision 1.2 retrieving revision 1.2.24.1 diff -u -r1.2 -r1.2.24.1 --- glyph-test.el 2001/04/12 18:24:47 1.2 +++ glyph-test.el 2005/02/16 00:48:28 1.2.24.1 ＠＠ -1,3 +1,6 ＠＠ +;; Let us see problems instantiating the glyphs below +(setq log-warning-minimum-level 'debug) + (set-extent-begin-glyph (make-extent (point) (point)) (setq im (make-glyph [xbm :file "xemacsicon.xbm"]))) ＠＠ -90,11 +93,17 ＠＠ (sit-for 0.1))) ;; progress gauge in the modeline -(setq global-mode-string - (cons (make-extent nil nil) - (setq pg (make-glyph + +(setq pg (make-glyph [progress-gauge :width 5 :pixel-height 16 - :descriptor "ok"])))) + :descriptor "ok"])) + +(setq global-mode-string + (list + (cons (make-extent nil nil) pg) + "foo" + (cons (make-extent nil nil) pg))) + ;; progress the progress ... (let ((x 0)) (while (<= x 100) 1.3.10.1 +1 -1 XEmacs/xemacs/tests/gutter-test.el Index: gutter-test.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/tests/gutter-test.el,v retrieving revision 1.3 retrieving revision 1.3.10.1 diff -u -r1.3 -r1.3.10.1 --- gutter-test.el 2002/06/04 06:05:51 1.3 +++ gutter-test.el 2005/02/16 00:48:28 1.3.10.1 ＠＠ -2,7 +2,7 ＠＠ (setq str-ext (make-extent 0 5 str)) (set-extent-begin-glyph str-ext - (make-glyph [xpm :file "../etc/xemacs-icon.xpm"])) + (make-glyph `[xpm :file ,(expand-file-name "xemacs-icon.xpm" data-directory)])) (set-extent-property str-ext 'mouse-face 'highlight) (setq str2 "Hello\n")