From: tomo Date: Wed, 10 May 2000 08:31:46 +0000 (+0000) Subject: This commit was generated by cvs2svn to compensate for changes in r1408, X-Git-Tag: r21-2-34~2^2~1 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=93d92945bc8463467a6f2799453c6114beaa37ce;hp=67be3f62f20e42d9f33f77cd1230e48cdf4f845c;p=chise%2Fxemacs-chise.git- This commit was generated by cvs2svn to compensate for changes in r1408, which included commits to RCS files with non-trunk default branches. --- diff --git a/configure.usage b/configure.usage index 6b95066..89c648e 100644 --- a/configure.usage +++ b/configure.usage @@ -88,6 +88,17 @@ Window-system options: unpredictable. --without-xmu (*) For those unfortunates whose vendors don't ship Xmu. --external-widget Compile with external widget support. + + +TTY options: + +--without-tty Don't support TTY-s. +--with-ncurses (*) Use the ncurses library for tty support. +--with-gpm (*) Compile in support for General Purpose Mouse. + + +Image options: + --with-xpm (*) Compile with support for XPM files. It is highly recommended that you obtain XPM (version 3.4h or better) if you don't already @@ -107,22 +118,8 @@ Window-system options: Get if from the XEmacs FTP site. -TTY options: +Sound options: ---without-tty Don't support TTY-s. ---with-ncurses (*) Use the ncurses library for tty support. ---with-gpm (*) Compile in support for General Purpose Mouse. - - -Additional features: - ---with-tooltalk (*) Support the ToolTalk IPC protocol. ---with-workshop Support the Sun WorkShop (formerly Sparcworks) - development environment. ---with-socks Compile with support for SOCKS (an Internet proxy). ---with-database=TYPE (*) Compile with database support. Valid types are - `no' or a comma-separated list of one or more - of `berkdb' and either `dbm' or `gnudbm'. --with-sound=TYPE,[TYPE],... Compile with native sound support. Valid types are `native', `nas' and `esd'. Prefix a type with 'no' to disable. @@ -133,17 +130,36 @@ Additional features: --native-sound-lib=LIB Native sound support library. Needed on Suns with --with-sound=both because both sound libraries are called libaudio. ---with-pop support POP for mail retrieval ---with-kerberos support Kerberos-authenticated POP ---with-hesiod support Hesiod to get the POP server host ---with-dnet (*) Compile with support for DECnet. + + +Database options: + +--with-database=TYPE (*) Compile with database support. Valid types are + `no' or a comma-separated list of one or more + of `berkdb' and either `dbm' or `gnudbm'. --with-ldap (*) Compile with support for the LDAP protocol (requires installed LDAP libraries on the system). --with-postgresql (*) Compile with support for the PostgreSQL RDBMS (requires installed PostreSQL libraries on the system). + + +Mail options: + --mail-locking=TYPE (*) Specify the locking to be used by movemail to prevent concurrent updates of mail spool files. Valid types are `lockf', `flock', and `dot'. +--with-pop support POP for mail retrieval +--with-kerberos support Kerberos-authenticated POP +--with-hesiod support Hesiod to get the POP server host + + +Additional features: + +--with-tooltalk (*) Support the ToolTalk IPC protocol. +--with-workshop Support the Sun WorkShop (formerly Sparcworks) + development environment. +--with-socks Compile with support for SOCKS (an Internet proxy). +--with-dnet (*) Compile with support for DECnet. --with-modules Compile in experimental support for dynamically loaded libraries (Dynamic Shared Objects). --with-site-lisp=yes Allow for a site-lisp directory in the XEmacs hierarchy @@ -232,7 +248,7 @@ Other options: --with-system-malloc Force use of the system malloc, rather than GNU malloc. --with-debug-malloc Use the debugging malloc package. --with-clash-detection Use lock files to detect multiple edits of the same - file. The default is to not do clash detection. + file. The default is to do clash detection. --lockdir=DIR The directory to put clash detection files in, such as `/var/lock/emacs'. Defaults to `${statedir}/xemacs/lock'. diff --git a/etc/Emacs.ad b/etc/Emacs.ad index 4754a7f..39ac03a 100644 --- a/etc/Emacs.ad +++ b/etc/Emacs.ad @@ -191,6 +191,10 @@ *menubar*Font: -*-helvetica-bold-r-*-*-*-120-*-*-*-*-iso8859-* *popup*Font: -*-helvetica-bold-r-*-*-*-120-*-*-*-*-iso8859-* +! Gui elements share this font +! +Emacs.gui-element.attributeFont: -*-helvetica-medium-r-*-*-*-120-*-*-*-*-iso8859-* + ! Font in the Motif dialog boxes. ! (Motif uses `fontList' while most other things use `font' - if you don't ! know why you probably don't want to.) @@ -260,6 +264,11 @@ Ctrlm: ArmAndActivate()\n : Enter()\n\ : Leave()\n +! Native Widget translations +! ======================= +Emacs*Text*translations: #override\n\ + : widget-focus-in()\n + ! XIM input method style ! ======================= diff --git a/etc/NEWS b/etc/NEWS index 9425a05..0f586dd 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -239,14 +239,14 @@ See `lprogress-display' for details. This support has been switched on by default for font-lock and some web browsing functions. If you do not like this behaviour set `progress-display-use-echo-area'. -** Etags changes. - ** The PostgreSQL Relational Database Management System is now supported. It is now possible to build XEmacs so that the programming interface to the PostgreSQL RDBMS (libpq) is available in XEmacs Lisp. Supported versions of PostgreSQL are 6.5.3 (earlier versions may work, but have not been tested) and 7.0-beta1. +** Etags changes. + *** In DOS, etags looks for file.cgz if it cannot find file.c. *** New option --ignore-case-regex is an alternative to --regex. It is now diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog index 2615c4a..4204c58 100644 --- a/lib-src/ChangeLog +++ b/lib-src/ChangeLog @@ -1,3 +1,19 @@ +2000-05-01 Martin Buchholz + + * XEmacs 21.2.33 is released. + +2000-04-19 Martin Buchholz + + * gnuclient.c (initialize_signals): Always use full ANSI prototypes. + +2000-04-06 Kirill 'Big K' Katsnelson + + * i.c: New file, source for the i utility. + +2000-03-22 Mike Alexander + + * make-dump-id.c (gettimeofday): new (Windows only) + 2000-03-20 Martin Buchholz * XEmacs 21.2.32 is released. diff --git a/lib-src/gnuclient.c b/lib-src/gnuclient.c index b2f5c19..6d96b47 100644 --- a/lib-src/gnuclient.c +++ b/lib-src/gnuclient.c @@ -121,7 +121,7 @@ pass_signal_to_emacs (int sig) } void -initialize_signals () +initialize_signals (void) { /* Set up signal handler to pass relevant signals to emacs process. We used to send SIGSEGV, SIGBUS, SIGPIPE, SIGILL and others to diff --git a/lisp/autoload.el b/lisp/autoload.el index 2862234..b9b0a60 100644 --- a/lisp/autoload.el +++ b/lisp/autoload.el @@ -114,10 +114,12 @@ the section of autoloads for a file.") (defun autoload-trim-file-name (file) "Returns a relative pathname of FILE including the last directory." (setq file (expand-file-name file)) - (file-relative-name file (file-name-directory - (directory-file-name - (file-name-directory file))))) - + (replace-in-string + (file-relative-name file (file-name-directory + (directory-file-name + (file-name-directory file)))) + "\\\\" "/")) + ;;;###autoload (defun generate-file-autoloads (file &optional funlist) "Insert at point a loaddefs autoload section for FILE. @@ -339,7 +341,7 @@ are used." "Generic filename to put autoloads into. Unless you are an XEmacs maintainer, it is probably unwise to change this.") -(defvar autoload-target-directory "../lisp/prim/" +(defvar autoload-target-directory "../lisp/" "Directory to put autoload declaration file into. Unless you know what you're doing, don't mess with this.") @@ -349,7 +351,11 @@ Unless you know what you're doing, don't mess with this.") data-directory) "*File `update-file-autoloads' puts autoloads into. A .el file can set this in its local variables section to make its -autoloads go somewhere else.") +autoloads go somewhere else. + +Note that `batch-update-directory' binds this variable to its own value, +generally the file named `autoload-file-name' in the directory being +updated.") (defconst cusload-file-name "custom-load.el" "Generic filename ot put custom loads into. @@ -458,7 +464,9 @@ This function refuses to update autoloads files." (defun update-autoloads-from-directory (dir) "Update `generated-autoload-file' with all the current autoloads from DIR. This runs `update-file-autoloads' on each .el file in DIR. -Obsolete autoload entries for files that no longer exist are deleted." +Obsolete autoload entries for files that no longer exist are deleted. +Note that, if this function is called from `batch-update-directory', +`generated-autoload-file' was rebound in that function." (interactive "DUpdate autoloads for directory: ") (setq dir (expand-file-name dir)) (let ((simple-dir (file-name-as-directory @@ -534,18 +542,24 @@ on the command line." (defvar autoload-package-name nil) +;; #### this function is almost identical, but subtly different, +;; from batch-update-autoloads. Steve, it's your responsibility to +;; clean this up. The two should be merged, but I'm not sure what +;; package-creation scripts out there might be using this. --ben + ;;;###autoload (defun batch-update-directory () - "Update the autoloads for the directory on the command line. -Runs `update-file-autoloads' on each file in the given directory, must -be used only with -batch and kills XEmacs on completion." + "Update the autoloads for the directories on the command line. +Runs `update-file-autoloads' on each file in the given directory, and must +be used only with -batch." (unless noninteractive (error "batch-update-directory is to be used only with -batch")) (let ((defdir default-directory) (enable-local-eval nil)) ; Don't query in batch mode. (dolist (arg command-line-args-left) (setq arg (expand-file-name arg defdir)) - (let ((generated-autoload-file (concat arg "/" autoload-file-name))) + (let ((generated-autoload-file (expand-file-name autoload-file-name + arg))) (cond ((file-directory-p arg) (message "Updating autoloads in directory %s..." arg) @@ -561,6 +575,36 @@ be used only with -batch and kills XEmacs on completion." ) (setq command-line-args-left nil))) +;; #### i created the following. this one and the last should be merged into +;; batch-update-autoloads. --ben + +;;;###autoload +(defun batch-update-one-directory () + "Update the autoloads for a single directory on the command line. +Runs `update-file-autoloads' on each file in the given directory, and must +be used only with -batch." + (unless noninteractive + (error "batch-update-directory is to be used only with -batch")) + (let ((defdir default-directory) + (enable-local-eval nil)) ; Don't query in batch mode. + (let ((arg (car command-line-args-left))) + (setq command-line-args-left (cdr command-line-args-left)) + (setq arg (expand-file-name arg defdir)) + (let ((generated-autoload-file (expand-file-name autoload-file-name + arg))) + (cond + ((file-directory-p arg) + (message "Updating autoloads in directory %s..." arg) + (update-autoloads-from-directory arg)) + (t (error "No such file or directory: %s" arg))) + (fixup-autoload-buffer (concat (if autoload-package-name + autoload-package-name + (file-name-nondirectory arg)) + "-autoloads")) + (save-some-buffers t)) + ;; (message "Done") + ))) + (provide 'autoload) ;;; autoload.el ends here diff --git a/lisp/cl-compat.el b/lisp/cl-compat.el index 82ba291..960a1ea 100644 --- a/lisp/cl-compat.el +++ b/lisp/cl-compat.el @@ -56,8 +56,10 @@ (defmacro defkeyword (x &optional doc) (list* 'defconst x (list 'quote x) (and doc (list doc)))) -(defun keywordp (sym) - (and (symbolp sym) (eq (aref (symbol-name sym) 0) ?\:) (set sym sym))) +;; XEmacs change. +;; We have built-in function. +;;(defun keywordp (sym) +;; (and (symbolp sym) (eq (aref (symbol-name sym) 0) ?\:) (set sym sym))) (defun keyword-of (sym) (or (keywordp sym) (keywordp (intern (format ":%s" sym))))) diff --git a/lisp/dialog.el b/lisp/dialog.el index 32f6e01..bd94eaa 100644 --- a/lisp/dialog.el +++ b/lisp/dialog.el @@ -28,33 +28,35 @@ ;; This file is dumped with XEmacs (when dialog boxes are compiled in). +;; Dialog boxes are non-modal at the C level, but made modal at the +;; Lisp level via hacks in functions such as yes-or-no-p-dialog-box +;; below. Perhaps there should be truly modal dialog boxes +;; implemented at the C level for safety. All code using dialog boxes +;; should be careful to assume that the environment, for example the +;; current buffer, might be completely different after returning from +;; yes-or-no-p-dialog-box, but such code is difficult to write and test. + ;;; Code: (defun yes-or-no-p-dialog-box (prompt) - "Ask user a \"y or n\" question with a popup dialog box. -Returns t if answer is \"yes\". + "Ask user a yes-or-no question with a popup dialog box. +Return t if the answer is \"yes\". Takes one argument, which is the string to display to ask the question." - (let ((echo-keystrokes 0) - event) + (save-selected-frame (popup-dialog-box - ;; "Non-violent language please!" says Robin. - (cons prompt '(["%_Yes" yes t] ["%_No" no t] nil ["%_Cancel" abort t]))) -; (cons prompt '(["%_Yes" yes t] ["%_No" no t] nil ["A%_bort" abort t]))) - (catch 'ynp-done - (while t - (setq event (next-command-event event)) - (cond ((and (misc-user-event-p event) (eq (event-object event) 'yes)) - (throw 'ynp-done t)) - ((and (misc-user-event-p event) (eq (event-object event) 'no)) - (throw 'ynp-done nil)) - ((and (misc-user-event-p event) - (or (eq (event-object event) 'abort) - (eq (event-object event) 'menu-no-selection-hook))) - (signal 'quit nil)) - ((button-release-event-p event) ;; don't beep twice - nil) - (t - (beep) - (message "please answer the dialog box"))))))) + (list prompt ["Yes" yes t] ["No" no t] nil ["Cancel" cancel t])) + (let (event) + (catch 'ynp-done + (while t + (setq event (next-command-event event)) + (when (misc-user-event-p event) + (message "%s" (event-object event)) + (case (event-object event) + ((yes) (throw 'ynp-done t)) + ((no) (throw 'ynp-done nil)) + ((cancel menu-no-selection-hook) (signal 'quit nil)))) + (unless (button-release-event-p event) ; don't beep twice + (beep) + (message "please answer the dialog box"))))))) (defun yes-or-no-p-maybe-dialog-box (prompt) "Ask user a yes-or-no question. Return t if answer is yes. @@ -78,10 +80,9 @@ Also accepts Space to mean yes, or Delete to mean no." (yes-or-no-p-dialog-box prompt) (y-or-n-p-minibuf prompt))) -(if (fboundp 'popup-dialog-box) - (progn - (fset 'yes-or-no-p 'yes-or-no-p-maybe-dialog-box) - (fset 'y-or-n-p 'y-or-n-p-maybe-dialog-box))) +(when (fboundp 'popup-dialog-box) + (fset 'yes-or-no-p 'yes-or-no-p-maybe-dialog-box) + (fset 'y-or-n-p 'y-or-n-p-maybe-dialog-box)) ;; this is call-compatible with the horribly-named FSF Emacs function ;; `x-popup-dialog'. I refuse to use that name. @@ -154,4 +155,63 @@ minibuffer contents show." (apply 'message-box fmt args) (apply 'message fmt args))) +(defun make-dialog-box (&optional spec props parent) + "Create a frame suitable for use as a general dialog box. +The frame is made a child of PARENT (defaults to the selected frame), +and has additional properties PROPS, as well as `dialog-frame-plist'. +SPEC is a string or glyph to be placed in the gutter. If INVISIBLE is +non-nil then the frame is initially unmapped. +Normally the created frame has no modelines, menubars, scrollbars, +minibuffer or toolbars and is entirely covered by its gutter." + (or parent (setq parent (selected-frame))) + (let* ((ftop (frame-property parent 'top)) + (fleft (frame-property parent 'left)) + (fwidth (frame-pixel-width parent)) + (fheight (frame-pixel-height parent)) + (fonth (font-height (face-font 'default))) + (fontw (font-width (face-font 'default))) + (props (append props dialog-frame-plist)) + (dfheight (plist-get props 'height)) + (dfwidth (plist-get props 'width)) + (unmapped (plist-get props 'initially-unmapped)) + (gutter-spec spec) + (name (or (plist-get props 'name) "XEmacs")) + (frame nil)) + (plist-remprop props 'initially-unmapped) + ;; allow the user to just provide a glyph + (when (glyphp spec) + (setq gutter-spec (copy-sequence "\n")) + (set-extent-begin-glyph (make-extent 0 1 gutter-spec) spec)) + ;; under FVWM at least, if I don't specify the initial position, + ;; it ends up always at (0, 0). xwininfo doesn't tell me + ;; that there are any program-specified position hints, so + ;; it must be an FVWM bug. So just be smashing and position + ;; in the center of the selected frame. + (setq frame (make-frame + (append props + `(popup ,parent initially-unmapped t + menubar-visible-p nil + has-modeline-p nil + default-toolbar-visible-p nil + top-gutter-visible-p t + top-gutter-height ,(* dfheight fonth) + top-gutter ,gutter-spec + minibuffer none + name ,name + modeline-shadow-thickness 0 + vertical-scrollbar-visible-p nil + horizontal-scrollbar-visible-p nil + unsplittable t + left ,(+ fleft (- (/ fwidth 2) + (/ (* dfwidth fontw) + 2))) + top ,(+ ftop (- (/ fheight 2) + (/ (* dfheight fonth) + 2))))))) + (set-face-foreground 'modeline [default foreground] frame) + (set-face-background 'modeline [default background] frame) + (unless unmapped (make-frame-visible frame)) + frame)) + + ;;; dialog.el ends here diff --git a/lisp/etags.el b/lisp/etags.el index f68527b..c3245d7 100644 --- a/lisp/etags.el +++ b/lisp/etags.el @@ -190,9 +190,12 @@ the current buffer." (when (file-readable-p parent-tag-file) (push parent-tag-file result))) ;; tag-table-alist - (let ((key (or buffer-file-name - (concat default-directory (buffer-name)))) - expression) + (let* ((key (or buffer-file-name + (concat default-directory (buffer-name)))) + (key (if (eq system-type 'windows-nt) + (replace-in-string key "\\\\" "/") + key)) + expression) (dolist (item tag-table-alist) (setq expression (car item)) ;; If the car of the alist item is a string, apply it as a regexp @@ -735,6 +738,16 @@ If it returns non-nil, this file needs processing by evalling (cons buf startpos)))) ;;;###autoload +(defun find-tag-at-point (tagname &optional other-window) + "*Find tag whose name contains TAGNAME. +Identical to `find-tag' but does not prompt for tag when called interactively; +instead, uses tag around or before point." + (interactive (if current-prefix-arg + '(nil nil) + (list (find-tag-default) nil))) + (find-tag tagname other-window)) + +;;;###autoload (defun find-tag (tagname &optional other-window) "*Find tag whose name contains TAGNAME. Selects the buffer that the tag is contained in diff --git a/lisp/faces.el b/lisp/faces.el index 4fa87b9..616c510 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1589,14 +1589,17 @@ you want to add code to do stuff like this, use the create-device-hook." nil 'append)) ) -;; New function with 20.1, suggested by Per Abrahamsen, coded by Kyle Jones. +;; New function with 20.1, suggested by Per Abrahamsen, coded by Kyle +;; Jones and Hrvoje Niksic. (defun set-face-stipple (face pixmap &optional frame) "Change the stipple pixmap of FACE to PIXMAP. This is an Emacs compatibility function; consider using set-face-background-pixmap instead. PIXMAP should be a string, the name of a file of pixmap data. -The directories listed in the `x-bitmap-file-path' variable are searched. +The directories listed in the variables `x-bitmap-file-path' and +`mswindows-bitmap-file-path' under X and MS Windows respectively +are searched. Alternatively, PIXMAP may be a list of the form (WIDTH HEIGHT DATA) where WIDTH and HEIGHT are the size in pixels, and DATA is @@ -1607,20 +1610,33 @@ If the optional FRAME argument is provided, change only in that frame; otherwise change each frame." (while (not (find-face face)) (setq face (signal 'wrong-type-argument (list 'facep face)))) - (locate-file pixmap x-bitmap-file-path '(".xbm" "")) - (while (cond ((stringp pixmap) - (unless (file-readable-p pixmap) - (setq pixmap `[xbm :file ,pixmap])) - nil) - ((and (consp pixmap) (= (length pixmap) 3)) - (setq pixmap `[xbm :data ,pixmap]) - nil) - (t t)) - (setq pixmap (signal 'wrong-type-argument - (list 'stipple-pixmap-p pixmap)))) - (while (and frame (not (framep frame))) - (setq frame (signal 'wrong-type-argument (list 'framep frame)))) - (set-face-background-pixmap face pixmap frame)) + (let ((bitmap-path (ecase (console-type) + (x x-bitmap-file-path) + (mswindows mswindows-bitmap-file-path))) + instantiator) + (while + (null + (setq instantiator + (cond ((stringp pixmap) + (let ((file (if (file-name-absolute-p pixmap) + pixmap + (locate-file pixmap bitmap-path + '(".xbm" ""))))) + (and file + `[xbm :file ,file]))) + ((and (listp pixmap) (= (length pixmap) 3)) + `[xbm :data ,pixmap]) + (t nil)))) + ;; We're signaling a continuable error; let's make sure the + ;; function `stipple-pixmap-p' at least exists. + (flet ((stipple-pixmap-p (pixmap) + (or (stringp pixmap) + (and (listp pixmap) (= (length pixmap) 3))))) + (setq pixmap (signal 'wrong-type-argument + (list 'stipple-pixmap-p pixmap))))) + (while (and frame (not (framep frame))) + (setq frame (signal 'wrong-type-argument (list 'framep frame)))) + (set-face-background-pixmap face instantiator frame))) ;; Create the remaining standard faces now. This way, packages that we dump diff --git a/lisp/finder.el b/lisp/finder.el index b0fa4de..503b7f8 100644 --- a/lisp/finder.el +++ b/lisp/finder.el @@ -167,7 +167,7 @@ arguments compiles from `load-path'." (lambda (d) (mapcar (lambda (f) - (when (not (member f processed)) + (when (and (not (member f processed)) (file-readable-p f)) (let (summary keystart keywords) (setq processed (cons f processed)) (if (not finder-compile-keywords-quiet) diff --git a/lisp/font-lock.el b/lisp/font-lock.el index d5e26d8..3969793 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -1496,17 +1496,22 @@ LIMIT can be modified by the value of its PRE-MATCH-FORM." START should be at the beginning of a line." (let ((loudly (and font-lock-verbose (>= (- end start) font-lock-message-threshold)))) - (let ((case-fold-search font-lock-keywords-case-fold-search) - (keywords (cdr (if (eq (car-safe font-lock-keywords) t) - font-lock-keywords - (font-lock-compile-keywords)))) - (bufname (buffer-name)) (count 5) - keyword matcher highlights) + (let* ((case-fold-search font-lock-keywords-case-fold-search) + (keywords (cdr (if (eq (car-safe font-lock-keywords) t) + font-lock-keywords + (font-lock-compile-keywords)))) + (bufname (buffer-name)) + (progress 5) (old-progress 5) + (iter 0) + (nkeywords (length keywords)) + keyword matcher highlights) ;; ;; Fontify each item in `font-lock-keywords' from `start' to `end'. + ;; In order to measure progress accurately we need to know how + ;; many keywords we have and how big the region is. Then progress + ;; is ((pos - start)/ (end - start) * nkeywords + ;; + iteration / nkeywords) * 100 (while keywords - (when loudly (lprogress-display 'font-lock "Fontifying %s... (regexps)" - (setq count (+ count 5)) bufname)) ;; ;; Find an occurrence of `matcher' from `start' to `end'. (setq keyword (car keywords) matcher (car keyword)) @@ -1515,6 +1520,14 @@ START should be at the beginning of a line." (if (stringp matcher) (re-search-forward matcher end t) (funcall matcher end))) + ;; calculate progress + (setq progress + (+ (/ (* (- (point) start) 95) (* (- end start) nkeywords)) + (/ (* iter 95) nkeywords) 5)) + (when (and loudly (> progress old-progress)) + (lprogress-display 'font-lock "Fontifying %s... (regexps)" + progress bufname)) + (setq old-progress progress) ;; Apply each highlight to this instance of `matcher', which may be ;; specific highlights or more keywords anchored to `matcher'. (setq highlights (cdr keyword)) @@ -1528,6 +1541,7 @@ START should be at the beginning of a line." (and end (goto-char end))) (font-lock-fontify-anchored-keywords (car highlights) end)) (setq highlights (cdr highlights)))) + (setq iter (1+ iter)) (setq keywords (cdr keywords)))) (if loudly (lprogress-display 'font-lock "Fontifying %s... " 100 (buffer-name))))) diff --git a/lisp/help.el b/lisp/help.el index e2a7a0d..901724b 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -730,7 +730,10 @@ of the key sequence that ran this command." (stringp Installation-string)) (with-displaying-help-buffer (lambda () - (princ Installation-string)) + (princ + (if (fboundp 'decode-coding-string) + (decode-coding-string Installation-string 'automatic-conversion) + Installation-string))) "Installation") (error "No Installation information available."))) diff --git a/lisp/lisp-mode.el b/lisp/lisp-mode.el index 2772387..502a93c 100644 --- a/lisp/lisp-mode.el +++ b/lisp/lisp-mode.el @@ -90,8 +90,9 @@ ;Don't have a menubar entry in Lisp Interaction mode. Otherwise, the ;*scratch* buffer has a Lisp menubar item! Very confusing. -;(defvar lisp-interaction-mode-menubar-menu -; (purecopy (cons "Lisp" (cdr lisp-interaction-mode-popup-menu)))) +;Jan Vroonhof really wants this, so it's back. --ben +(defvar lisp-interaction-mode-menubar-menu + (purecopy (cons "%_Lisp" (cdr lisp-interaction-mode-popup-menu)))) (defvar emacs-lisp-mode-menubar-menu (purecopy (cons "%_Lisp" (cdr emacs-lisp-mode-popup-menu)))) @@ -363,7 +364,13 @@ if that value is non-nil." (setq major-mode 'lisp-interaction-mode) (setq mode-name "Lisp Interaction") (setq mode-popup-menu lisp-interaction-mode-popup-menu) - + (if (and (featurep 'menubar) + current-menubar) + (progn + ;; make a local copy of the menubar, so our modes don't + ;; change the global menubar + (set-buffer-menubar current-menubar) + (add-submenu nil lisp-interaction-mode-menubar-menu))) (set-syntax-table emacs-lisp-mode-syntax-table) (lisp-mode-variables nil) (run-hooks 'lisp-interaction-mode-hook)) diff --git a/lisp/loaddefs.el b/lisp/loaddefs.el index 7217ae7..52458c3 100644 --- a/lisp/loaddefs.el +++ b/lisp/loaddefs.el @@ -86,11 +86,23 @@ ;; making it more likely you will get a unique match. (setq completion-ignored-extensions (mapcar 'purecopy - '(".o" ".elc" "~" ".bin" ".lbin" ".fasl" - ".dvi" ".toc" ;".log" - ".aux" ".a" ".ln" - ".lof" ".blg" ".bbl" ".glo" ".idx" ".lot" ".fmt" - ".diff" ".oi" ".class"))) + ;; this is way way way bogus. + ;; completely wtf? + ;; the only things that should be here are those that are + ;; (a) universally recognizable, and + ;; (b) obvious backup files, or + ;; (c) obvious binary files that are generated on a + ;; PER-SOURCE-FILE basis, so that they will actually + ;; cause annoyance. This includes .exe files, e.g. +; '(".o" ".elc" "~" ".bin" ".lbin" ".fasl" +; ".dvi" ".toc" ;".log" +; ".aux" ".a" ".ln" +; ".lof" ".blg" ".bbl" ".glo" ".idx" ".lot" ".fmt" +; ".diff" ".oi" ".class"))) + '(".o" ".obj" ".elc" "~" + ".bin" ".lbin" ;; #### these are doubtful, esp. the latter. + ".dvi";; possibly doubtful, too. + ".class"))) ;; This needs to be redone better. -slb diff --git a/lisp/loadup.el b/lisp/loadup.el index 964cd54..df70360 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -45,7 +45,14 @@ (defvar Installation-string nil "Description of XEmacs installation.") -(let ((gc-cons-threshold 30000)) +;(start-profiling) + +(let ((gc-cons-threshold + ;; setting it low makes loadup incredibly fucking slow. + ;; no need to do it when not dumping. + (if (and purify-flag + (not (memq 'quick-build internal-error-checking))) + 30000 3000000))) ;; This is awfully damn early to be getting an error, right? (call-with-condition-handler 'really-early-error-handler @@ -110,7 +117,9 @@ (if full-path (prog1 (load full-path) - (garbage-collect)) + ;; but garbage collection really slows down loading. + (unless (memq 'quick-build internal-error-checking) + (garbage-collect))) (external-debugging-output (format "\nLoad file %s: not found\n" file)) ;; Uncomment in case of trouble @@ -156,7 +165,8 @@ ;; is generated. For VMS, you must edit ../../vms/makedoc.com. ;; For other systems, you must edit ../../src/Makefile.in.in. (when (load "site-load" t) - (garbage-collect)) + (garbage-collect) +) ;;FSFmacs randomness ;;(if (fboundp 'x-popup-menu) @@ -193,6 +203,71 @@ ) ;; frequent garbage collection +;(stop-profiling) + +;; yuck! need to insert the function def here, and rewrite the dolist +;; loop below. + +;(defun loadup-profile-results (&optional info stream) +; "Print profiling info INFO to STREAM in a pretty format. +;If INFO is omitted, the current profiling info is retrieved using +; `get-profiling-info'. +;If STREAM is omitted, either a *Profiling Results* buffer or standard +; output are used, depending on whether the function was called +; interactively or not." +; (interactive) +; (setq info (if info +; (copy-alist info) +; (get-profiling-info))) +; (when (and (not stream) +; (interactive-p)) +; (pop-to-buffer (get-buffer-create "*Profiling Results*")) +; (erase-buffer)) +; (let ((standard-output (or stream (if (interactive-p) +; (current-buffer) +; standard-output))) +; ;; Calculate the longest function +; (maxfunlen (apply #'max +; (length "Function Name") +; (mapcar +; (lambda (el) +; ;; Functions longer than 50 characters (usually +; ;; anonymous functions) don't qualify +; (let ((l (length (format "%s" (car el))))) +; (if (< l 50) +; l 0))) +; info)))) +; (princ (format "%-*s Ticks %%/Total Call Count\n" +; maxfunlen "Function Name")) +; (princ (make-string maxfunlen ?=)) +; (princ " ===== ======= ==========\n") +; (let ((sum (float (apply #'+ (mapcar #'cdr info))))) +; (let (entry +; (entry-list (nreverse (sort info #'cdr-less-than-cdr)))) +; (while entry-list +; (setq entry (car entry-list)) +; (princ (format "%-*s %-5d %-6.3f %s\n" +; maxfunlen (car entry) (cdr entry) +; (* 100 (/ (cdr entry) sum)) +; (or (gethash (car entry) call-count-profile-table) +; ""))) +; (setq entry-list (cdr entry-list)))) +; (princ (make-string maxfunlen ?-)) +; (princ "---------------------------------\n") +; (princ (format "%-*s %-5d %-6.2f\n" maxfunlen "Total" sum 100.0)) +; (princ (format "\n\nOne tick = %g ms\n" +; (/ default-profiling-interval 1000.0))) +; (and (boundp 'internal-error-checking) +; internal-error-checking +; (princ " +;WARNING: Error checking is turned on in this XEmacs. This might make +; the measurements very unreliable.\n")))) +; (when (and (not stream) +; (interactive-p)) +; (goto-char (point-min)))) + +;(loadup-profile-results nil 'external-debugging-output) + ;; Dump into the name `xemacs' (only) (when (member "dump" command-line-args) (message "Dumping under the name xemacs") diff --git a/lisp/make-docfile.el b/lisp/make-docfile.el index 7a9365c..730a941 100644 --- a/lisp/make-docfile.el +++ b/lisp/make-docfile.el @@ -86,6 +86,8 @@ (load "packages.el") (load "setup-paths.el") (load "dump-paths.el") +(require 'custom) +(load "process") (let (preloaded-file-list) (load (expand-file-name "../lisp/dumped-lisp.el")) diff --git a/lisp/menubar-items.el b/lisp/menubar-items.el index 984d80f..eda0c93 100644 --- a/lisp/menubar-items.el +++ b/lisp/menubar-items.el @@ -4,7 +4,7 @@ ;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp. ;; Copyright (C) 1995 Sun Microsystems. ;; Copyright (C) 1995, 1996, 2000 Ben Wing. -;; Copyright (C) 1997 MORIOKA Tomohiko +;; Copyright (C) 1997 MORIOKA Tomohiko. ;; Maintainer: XEmacs Development Team ;; Keywords: frames, extensions, internal, dumped @@ -26,6 +26,27 @@ ;; Free Software Foundation, 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. +;;; Authorship: + +;; Created c. 1991 for Lucid Emacs. Originally called x-menubar.el. +;; Contained four menus -- File, Edit, Buffers, Help. +;; Dynamic menu changes possible only through activate-menubar-hook. +;; Also contained menu manipulation funs, e.g. find-menu-item, add-menu. +;; Options menu added for 19.9 by Jamie Zawinski, late 1993. +;; Major reorganization c. 1994 by Ben Wing; added many items and moved +;; some items to two new menus, Apps and Tools. (for 19.10?) +;; Generic menubar functions moved to new file, menubar.el, by Ben Wing, +;; 1995, for 19.12; also, creation of current buffers menu options, +;; and buffers menu changed from purely most-recent to sorted alphabetical, +;; by mode. Also added mode-popup-menu support. +;; New API (add-submenu, add-menu-button) and menu filter support added +;; late summer 1995 by Stig, for 19.13. Also popup-menubar-menu. +;; Renamed to menubar-items.el c. 1998, with MS Win support. +;; Options menu rewritten to use custom c. 1999 by ? (Jan Vroonhof?). +;; Major reorganization Mar. 2000 by Ben Wing; added many items and changed +;; top-level menus to File, Edit, View, Cmds, Tools, Options, Buffers. +;; Accelerator spec functionality added Mar. 2000 by Ben Wing. + ;;; Commentary: ;; This file is dumped with XEmacs (when window system and menubar support is @@ -126,8 +147,10 @@ which will not be used as accelerators." ["Save %_As..." write-file] ["Save So%_me Buffers" save-some-buffers] "-----" - ["%_Print Buffer" lpr-buffer - :active (fboundp 'lpr-buffer) + ["%_Print Buffer" generic-print-buffer + :active (or (valid-specifier-tag-p 'msprinter) + (and (not (eq system-type 'windows-nt)) + (fboundp 'lpr-buffer))) :suffix (if put-buffer-names-in-file-menu (buffer-name) "")] ["Prett%_y-Print Buffer" ps-print-buffer-with-faces :active (fboundp 'ps-print-buffer-with-faces) @@ -173,13 +196,12 @@ which will not be used as accelerators." ["Select %_All" mark-whole-buffer] ["Select %_Page" mark-page] "----" - ["%_1 Search..." isearch-forward] - ["%_2 Search Backward..." isearch-backward] - ["%_3 Replace..." query-replace] + ["%_Search..." make-search-dialog] + ["%_1 Replace..." query-replace] "----" - ["%_4 Search (Regexp)..." isearch-forward-regexp] - ["%_5 Search Backward (Regexp)..." isearch-backward-regexp] - ["%_6 Replace (Regexp)..." query-replace-regexp] + ["%_2 Search (Regexp)..." isearch-forward-regexp] + ["%_3 Search Backward (Regexp)..." isearch-backward-regexp] + ["%_4 Replace (Regexp)..." query-replace-regexp] ,@(when (featurep 'mule) '("----" @@ -336,8 +358,8 @@ which will not be used as accelerators." ["%_Open Rectangle" open-rectangle] ["%_Prefix Rectangle..." string-rectangle] ["Rectangle %_Mousing" - (customize-set-variable - mouse-track-rectangle-p (not mouse-track-rectangle-p)) + (customize-set-variable 'mouse-track-rectangle-p + (not mouse-track-rectangle-p)) :style toggle :selected mouse-track-rectangle-p] ) ("%_Sort" @@ -396,7 +418,6 @@ which will not be used as accelerators." (menu-truncate-list grep-history 10))))) (append menu '("---") items)))) ["%_Grep..." grep :active (fboundp 'grep)] - ["%_Repeat Grep" recompile :active (fboundp 'recompile)] ["%_Kill Grep" kill-compilation :active (and (fboundp 'kill-compilation) (fboundp 'compilation-find-buffer) @@ -409,28 +430,71 @@ which will not be used as accelerators." (progn (require 'compile) (let ((grep-command - (cons (concat grep-command " *") (length grep-command)))) + (cons (concat grep-command " *") + (length grep-command)))) + (call-interactively 'grep))) + :active (fboundp 'grep)] + ["Grep %_C and C Header Files in Current Directory..." + (progn + (require 'compile) + (let ((grep-command + (cons (concat grep-command " *.[chCH]" + ; i wanted to also use *.cc and *.hh. + ; see long comment below under Perl. + ) + (length grep-command)))) (call-interactively 'grep))) :active (fboundp 'grep)] - ["Grep %_C Files in Current Directory..." + ["Grep C Hea%_der Files in Current Directory..." (progn (require 'compile) (let ((grep-command - (cons (concat grep-command " *.[ch]") (length grep-command)))) + (cons (concat grep-command " *.[hH]" + ; i wanted to also use *.hh. + ; see long comment below under Perl. + ) + (length grep-command)))) (call-interactively 'grep))) :active (fboundp 'grep)] ["Grep %_E-Lisp Files in Current Directory..." (progn (require 'compile) (let ((grep-command - (cons (concat grep-command " *.el") (length grep-command)))) + (cons (concat grep-command " *.el") + (length grep-command)))) + (call-interactively 'grep))) + :active (fboundp 'grep)] + ["Grep %_Perl Files in Current Directory..." + (progn + (require 'compile) + (let ((grep-command + (cons (concat grep-command " *.pl" + ; i wanted to use this: + ; " *.pl *.pm *.am" + ; but grep complains if it can't + ; match anything in a glob, and + ; that screws other things up. + ; perhaps we need to first scan + ; each separate glob in the directory + ; to see if there are any files in + ; that glob, and if not, omit it. + ) + (length grep-command)))) + (call-interactively 'grep))) + :active (fboundp 'grep)] + ["Grep %_HTML Files in Current Directory..." + (progn + (require 'compile) + (let ((grep-command + (cons (concat grep-command " *.*htm*") + (length grep-command)))) (call-interactively 'grep))) :active (fboundp 'grep)] "---" ["%_Next Match" next-error :active (and (fboundp 'compilation-errors-exist-p) (compilation-errors-exist-p))] - ["%_Previous Match" previous-error + ["Pre%_vious Match" previous-error :active (and (fboundp 'compilation-errors-exist-p) (compilation-errors-exist-p))] ["%_First Match" first-error @@ -474,7 +538,7 @@ which will not be used as accelerators." ["%_Next Error" next-error :active (and (fboundp 'compilation-errors-exist-p) (compilation-errors-exist-p))] - ["%_Previous Error" previous-error + ["Pre%_vious Error" previous-error :active (and (fboundp 'compilation-errors-exist-p) (compilation-errors-exist-p))] ["%_First Error" first-error @@ -700,6 +764,11 @@ which will not be used as accelerators." ) ("%_Printing" + ["Set Printer %_Name for Generic Print Support..." + (customize-set-variable + 'printer-name + (read-string "Set printer name: " printer-name))] + "---" ["Command-Line %_Switches for `lpr'/`lp'..." ;; better to directly open a customization buffer, since the value ;; must be a list of strings, which is somewhat complex to prompt for. @@ -808,6 +877,23 @@ which will not be used as accelerators." (customize-set-variable 'mail-host-address (read-string "Set machine email name: " mail-host-address))] + ["Set %_SMTP Server..." + (progn + (require 'smtpmail) + (customize-set-variable + 'smtpmail-smtp-server + (read-string "Set SMTP server: " smtpmail-smtp-server))) + :active (and (boundp 'send-mail-function) + (eq send-mail-function 'smtpmail-send-it))] + ["SMTP %_Debug Info" + (progn + (require 'smtpmail) + (customize-set-variable 'smtpmail-debug-info + (not smtpmail-debug-info))) + :style toggle + :selected (and (boundp 'smtpmail-debug-info) smtpmail-debug-info) + :active (and (boundp 'send-mail-function) + (eq send-mail-function 'smtpmail-send-it))] "---" ("%_Open URLs With" ["%_Emacs-W3" @@ -1307,69 +1393,34 @@ which will not be used as accelerators." ("%_Help" ["%_About XEmacs..." about-xemacs] - ("%_Basics" - ["%_Installation" describe-installation - :active (boundp 'Installation-string)] - ;; Tutorials. - ,(if (featurep 'mule) - ;; Mule tutorials. - (let ((lang language-info-alist) (n 0) - submenu tut) - (while lang - (setq n (1+ n)) - (and (setq tut (assq 'tutorial (car lang))) - (not (string= (caar lang) "ASCII")) - (setq - submenu - (cons - `[,(concat (menu-item-generate-accelerator-spec n) - (caar lang)) - (help-with-tutorial nil ,(cdr tut))] - submenu))) - (setq lang (cdr lang))) - (append `("%_Tutorials" - :filter tutorials-menu-filter - ["%_Default" help-with-tutorial t - ,(concat "(" current-language-environment ")")]) - submenu)) - ;; Non mule tutorials. - (let ((lang tutorial-supported-languages) - (n 0) - submenu) - (while lang - (setq n (1+ n)) - (setq submenu - (cons - `[,(concat (menu-item-generate-accelerator-spec n) - (caar lang)) - (help-with-tutorial ,(format "TUTORIAL.%s" - (cadr (car lang))))] - submenu)) - (setq lang (cdr lang))) - (append '("%_Tutorials" - ["%_English" help-with-tutorial]) - submenu))) - ["%_News" view-emacs-news] - ["%_Packages" finder-by-keyword] - ["%_Splash" xemacs-splash-buffer]) "-----" + ["XEmacs %_News" view-emacs-news] + ["%_Obtaining XEmacs" describe-distribution] + "-----" + ("%_Info (Online Docs)" + ["%_Info Contents" info] + ["Lookup %_Key Binding..." Info-goto-emacs-key-command-node] + ["Lookup %_Command..." Info-goto-emacs-command-node] + ["Lookup %_Function..." Info-elisp-ref] + ["Lookup %_Topic..." Info-query]) ("XEmacs %_FAQ" ["%_FAQ (local)" xemacs-local-faq] - ["FAQ via %_WWW" xemacs-www-faq (boundp 'browse-url-browser-function)] - ["%_Home Page" xemacs-www-page (boundp 'browse-url-browser-function)]) + ["FAQ via %_WWW" xemacs-www-faq + :active (boundp 'browse-url-browser-function)] + ["%_Home Page" xemacs-www-page + :active (boundp 'browse-url-browser-function)]) + ("%_Tutorials" + :filter tutorials-menu-filter) ("%_Samples" - ["Sample .%_emacs" (find-file (locate-data-file "sample.emacs")) (locate-data-file "sample.emacs")] - ["Sample .%_Xdefaults" (find-file (locate-data-file "sample.Xdefaults")) (locate-data-file "sample.Xdefaults")] - ["Sample e%_nriched" (find-file (locate-data-file "enriched.doc")) (locate-data-file "enriched.doc")]) - "-----" - ("Lookup in %_Info" - ["%_Key Binding..." Info-goto-emacs-key-command-node] - ["%_Command..." Info-goto-emacs-command-node] - ["%_Function..." Info-elisp-ref] - ["%_Topic..." Info-query]) - ("%_Manuals" - ["%_Info" info] - ["%_Unix Manual..." manual-entry]) + ["Sample .%_emacs" + (find-file (locate-data-file "sample.emacs")) + :active (locate-data-file "sample.emacs")] + ["Sample .%_Xdefaults" + (find-file (locate-data-file "sample.Xdefaults")) + :active (locate-data-file "sample.Xdefaults")] + ["Sample e%_nriched" + (find-file (locate-data-file "enriched.doc")) + :active (locate-data-file "enriched.doc")]) ("%_Commands & Keys" ["%_Mode" describe-mode] ["%_Apropos..." hyper-apropos] @@ -1386,10 +1437,14 @@ which will not be used as accelerators." "-----" ["%_Recent Messages" view-lossage] ("%_Misc" + ["%_Current Installation Info" describe-installation + :active (boundp 'Installation-string)] ["%_No Warranty" describe-no-warranty] ["XEmacs %_License" describe-copying] - ["The Latest %_Version" describe-distribution]) - ["%_Send Bug Report..." report-emacs-bug + ["Find %_Packages" finder-by-keyword] + ["View %_Splash Screen" xemacs-splash-buffer] + ["%_Unix Manual..." manual-entry]) + ["Send %_Bug Report..." report-emacs-bug :active (fboundp 'report-emacs-bug)])))) @@ -1790,22 +1845,34 @@ If this is a relative filename, it is put into the same directory as your ;;; The Help menu -(if (featurep 'mule) - (defun tutorials-menu-filter (menu-items) - ;; If there's a tutorial for the current language environment, make it - ;; appear first as the default one. Otherwise, use the english one. - (let* ((menu menu-items) - (item (pop menu-items))) - (aset - item 3 - (concat "(" - (if (assoc - 'tutorial - (assoc current-language-environment language-info-alist)) - current-language-environment - "English") - ")")) - menu))) +(defun tutorials-menu-filter (menu-items) + (append + (if (featurep 'mule) + (if (assq 'tutorial + (assoc current-language-environment language-info-alist)) + `([,(concat "%_Default (" current-language-environment ")") + help-with-tutorial])) + '(["%_English" help-with-tutorial])) + (submenu-generate-accelerator-spec + (if (featurep 'mule) + ;; Mule tutorials. + (mapcan #'(lambda (lang) + (let ((tut (assq 'tutorial lang))) + (and tut + (not (string= (car lang) "ASCII")) + ;; skip current language, since we already + ;; included it first + (not (string= (car lang) + current-language-environment)) + `([,(car lang) + (help-with-tutorial nil ,(cdr tut))])))) + language-info-alist)) + ;; Non mule tutorials. + (mapcar #'(lambda (lang) + `[,(car lang) + (help-with-tutorial ,(format "TUTORIAL.%s" + (cadr lang)))]) + tutorial-supported-languages)))) (set-menubar default-menubar) @@ -1907,8 +1974,7 @@ The menu is computed by combining `global-popup-menu' and `mode-popup-menu'." (popup-menu bmenu))) (defun popup-menubar-menu (event) - "Pop up a copy of menu that also appears in the menubar" - ;; by Stig@hackvan.com + "Pop up a copy of menu that also appears in the menubar." (interactive "e") (let ((window (and (event-over-text-area-p event) (event-window event))) popup-menubar) diff --git a/lisp/menubar.el b/lisp/menubar.el index 3b58c86..cdf247b 100644 --- a/lisp/menubar.el +++ b/lisp/menubar.el @@ -30,7 +30,7 @@ ;; This file is dumped with XEmacs (when menubar support is compiled in). -;; Some stuff in FSF menu-bar.el is in x-menubar.el +;; Some stuff in FSF menu-bar.el is in menubar-items.el ;;; Code: diff --git a/lisp/modeline.el b/lisp/modeline.el index c5e428d..18baacd 100644 --- a/lisp/modeline.el +++ b/lisp/modeline.el @@ -575,8 +575,13 @@ parentheses on the modeline." ; this used to be "XEmacs:" (cons modeline-buffer-id-right-extent (purecopy " %17b"))) "Modeline control for identifying the buffer being displayed. -Its default value is \"XEmacs: %17b\" (NOT!). Major modes that edit things -other than ordinary files may change this (e.g. Info, Dired,...)") +Its default value is + + (list (cons modeline-buffer-id-left-extent (purecopy \"XEmacs%N:\")) + (cons modeline-buffer-id-right-extent (purecopy \" %17b\"))) + +Major modes that edit things other than ordinary files may change this +(e.g. Info, Dired,...).") (make-variable-buffer-local 'modeline-buffer-identification) ;; These are for the sake of minor mode menu. #### All of this is diff --git a/lisp/process.el b/lisp/process.el index 0c7b46a..c0602de 100644 --- a/lisp/process.el +++ b/lisp/process.el @@ -1,7 +1,7 @@ ;;; process.el --- commands for subprocesses; split out of simple.el ;; Copyright (C) 1985-7, 1993,4, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1995 Ben Wing. +;; Copyright (C) 1995, 2000 Ben Wing. ;; Author: Ben Wing ;; Maintainer: XEmacs Development Team @@ -26,6 +26,13 @@ ;;; Synched up with: FSF 19.30. +;;; Authorship: + +;; Created 1995 by Ben Wing during Mule work -- some commands split out +;; of simple.el and wrappers of *-internal functions created so they could +;; be redefined in a Mule world. +;; Lisp definition of call-process-internal added Mar. 2000 by Ben Wing. + ;;; Commentary: ;; This file is dumped with XEmacs. @@ -67,6 +74,108 @@ Wildcards and redirection are handled as usual in the shell." (start-process name buffer shell-file-name shell-command-switch (mapconcat #'identity args " "))) +(defun call-process-internal (program &optional infile buffer display &rest args) + "Call PROGRAM synchronously in separate process, with coding-system specified. +Arguments are + (PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS). +The program's input comes from file INFILE (nil means `/dev/null'). +Insert output in BUFFER before point; t means current buffer; + nil for BUFFER means discard it; 0 means discard and don't wait. +BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case, +REAL-BUFFER says what to do with standard output, as above, +while STDERR-FILE says what to do with standard error in the child. +STDERR-FILE may be nil (discard standard error output), +t (mix it with ordinary output), or a file name string. + +Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted. +Remaining arguments are strings passed as command arguments to PROGRAM. + +If BUFFER is 0, `call-process' returns immediately with value nil. +Otherwise it waits for PROGRAM to terminate and returns a numeric exit status + or a signal description string. +If you quit, the process is killed with SIGINT, or SIGKILL if you + quit again." + ;; #### remove windows-nt check when this is ready for prime time. + (if (or (noninteractive) (not (eq 'windows-nt system-type))) + (apply 'old-call-process-internal program infile buffer display args) + (let (proc inbuf errbuf discard) + (unwind-protect + (progn + (when infile + (setq infile (expand-file-name infile)) + (setq inbuf (generate-new-buffer "*call-process*")) + (with-current-buffer inbuf + (insert-file-contents-internal infile nil nil nil nil + coding-system-for-read))) + (let ((stderr (if (consp buffer) (second buffer) t))) + (if (consp buffer) (setq buffer (car buffer))) + (setq buffer + (cond ((null buffer) nil) + ((eq buffer t) (current-buffer)) + ;; use integerp for compatibility with existing + ;; call-process rmsism. + ((integerp buffer) (setq discard t) nil) + (t (get-buffer-create buffer)))) + (when (and stderr (not (eq t stderr))) + (setq stderr (expand-file-name stderr)) + (setq errbuf (generate-new-buffer "*call-process*"))) + (setq proc + (apply 'start-process-internal "*call-process*" + buffer + ;#### not implemented until my new process + ;changes go in. + ;(if (eq t stderr) buffer (list buffer errbuf)) + program args)) + (if buffer + (set-marker (process-mark proc) (point buffer) buffer)) + (unwind-protect + (progn + (catch 'call-process-done + (when (not discard) + (set-process-sentinel + proc + #'(lambda (proc status) + (cond ((eq 'exit (process-status proc)) + (set-process-sentinel proc nil) + (throw 'call-process-done + (process-exit-status proc))) + ((eq 'signal (process-status proc)) + (set-process-sentinel proc nil) + (throw 'call-process-done status)))))) + (when inbuf + (process-send-region proc 1 + (1+ (buffer-size inbuf)) inbuf)) + (process-send-eof proc) + (when discard + ;; we're trying really really hard to emulate + ;; the old call-process. + (if errbuf + (set-process-sentinel + proc + `(lambda (proc status) + (write-region-internal + 1 (1+ (buffer-size)) + ,stderr + nil 'major-rms-kludge-city nil + coding-system-for-write)))) + (setq errbuf nil) + (setq proc nil) + (throw 'call-process-done nil)) + (while t + (accept-process-output proc) + (if display (sit-for 0)))) + (when errbuf + (with-current-buffer errbuf + (write-region-internal 1 (1+ (buffer-size)) stderr + nil 'major-rms-kludge-city nil + coding-system-for-write)))) + (if proc (set-process-sentinel proc nil))))) + (if inbuf (kill-buffer inbuf)) + (if errbuf (kill-buffer errbuf)) + (condition-case nil + (if (and proc (process-live-p proc)) (kill-process proc)) + (error nil)))))) + (defun call-process (program &optional infile buffer displayp &rest args) "Call PROGRAM synchronously in separate process. The program's input comes from file INFILE (nil means `/dev/null'). diff --git a/lisp/simple.el b/lisp/simple.el index 5b306a1..cf2652a 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1667,10 +1667,71 @@ store it in a Lisp variable. Example: ; (set-marker (mark-marker) nil))) (defvar mark-ring nil - "The list of former marks of the current buffer, most recent first.") + "The list of former marks of the current buffer, most recent first. +This variable is automatically buffer-local.") (make-variable-buffer-local 'mark-ring) (put 'mark-ring 'permanent-local t) +(defvar dont-record-current-mark nil + "If set to t, the current mark value should not be recorded on the mark ring. +This is set by commands that manipulate the mark incidentally, to avoid +cluttering the mark ring unnecessarily. Under most circumstances, you do +not need to set this directly; it is automatically reset each time +`push-mark' is called, according to `mark-ring-unrecorded-commands'. This +variable is automatically buffer-local.") +(make-variable-buffer-local 'dont-record-current-mark) +(put 'dont-record-current-mark 'permanent-local t) + +;; a conspiracy between push-mark and handle-pre-motion-command +(defvar in-shifted-motion-command nil) + +(defcustom mark-ring-unrecorded-commands '(shifted-motion-commands + yank + mark-beginning-of-buffer + mark-bob + mark-defun + mark-end-of-buffer + mark-end-of-line + mark-end-of-sentence + mark-eob + mark-marker + mark-page + mark-paragraph + mark-sexp + mark-whole-buffer + mark-word) + "*List of commands whose marks should not be recorded on the mark stack. +Many commands set the mark as part of their action. Normally, all such +marks get recorded onto the mark stack. However, this tends to clutter up +the mark stack unnecessarily. You can control this by putting a command +onto this list. Then, any marks set by the function will not be recorded. + +The special value `shifted-motion-commands' causes marks set as a result +of selection using any shifted motion commands to not be recorded. + +The value `yank' affects all yank-like commands, as well as just `yank'." + :type '(repeat (choice (const :tag "shifted motion commands" + 'shifted-motion-commands) + (const :tag "functions that select text" + :inline t + '(mark-beginning-of-buffer + mark-bob + mark-defun + mark-end-of-buffer + mark-end-of-line + mark-end-of-sentence + mark-eob + mark-marker + mark-page + mark-paragraph + mark-sexp + mark-whole-buffer + mark-word)) + (const :tag "functions that paste text" + 'yank) + function)) + :group 'killing) + (defcustom mark-ring-max 16 "*Maximum size of mark ring. Start discarding off end if gets this big." :type 'integer @@ -1692,6 +1753,14 @@ ring, and push mark on global mark ring. With argument, jump to mark, and pop a new position for mark off the ring \(does not affect global mark ring\). +The mark ring is a per-buffer stack of marks, most recent first. Its +maximum length is controlled by `mark-ring-max'. Generally, when new +marks are set, the current mark is pushed onto the stack. You can pop +marks off the stack using \\[universal-argument] \\[set-mark-command]. The term \"ring\" is used because when +you pop a mark off the stack, the current mark value is pushed onto the +far end of the stack. If this is confusing, just think of the mark ring +as a stack. + Novice Emacs Lisp programmers often try to use the mark for the wrong purposes. See the documentation of `set-mark' for more information." (interactive "P") @@ -1699,6 +1768,7 @@ purposes. See the documentation of `set-mark' for more information." (push-mark nil nil t) (if (null (mark t)) (error "No mark set in this buffer") + (if dont-record-current-mark (pop-mark)) (goto-char (mark t)) (pop-mark)))) @@ -1713,7 +1783,7 @@ Activate mark if optional third arg ACTIVATE-REGION non-nil. Novice Emacs Lisp programmers often try to use the mark for the wrong purposes. See the documentation of `set-mark' for more information." (setq buffer (decode-buffer buffer)) ; XEmacs - (if (null (mark t buffer)) ; XEmacs + (if (or dont-record-current-mark (null (mark t buffer))) ; XEmacs nil ;; The save-excursion / set-buffer is necessary because mark-ring ;; is a buffer local variable @@ -1727,8 +1797,9 @@ purposes. See the documentation of `set-mark' for more information." (set-mark (or location (point buffer)) buffer) ; (set-marker (mark-marker) (or location (point)) (current-buffer)) ; FSF ;; Now push the mark on the global mark ring. - (if (or (null global-mark-ring) - (not (eq (marker-buffer (car global-mark-ring)) buffer))) + (if (and (not dont-record-current-mark) + (or (null global-mark-ring) + (not (eq (marker-buffer (car global-mark-ring)) buffer)))) ;; The last global mark pushed wasn't in this same buffer. (progn (setq global-mark-ring (cons (copy-marker (mark-marker t buffer)) @@ -1738,7 +1809,13 @@ purposes. See the documentation of `set-mark' for more information." (move-marker (car (nthcdr global-mark-ring-max global-mark-ring)) nil buffer) (setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil))))) - (or nomsg executing-kbd-macro (> (minibuffer-depth) 0) + (setq dont-record-current-mark + (not (not (or (and in-shifted-motion-command + (memq 'shifted-motion-commands + mark-ring-unrecorded-commands)) + (memq this-command mark-ring-unrecorded-commands))))) + (or dont-record-current-mark nomsg executing-kbd-macro + (> (minibuffer-depth) 0) (display-message 'command "Mark set")) (if activate-region (progn @@ -1877,7 +1954,8 @@ if `shifted-motion-keys-select-region' is nil." shifted-motion-keys-select-region (not (region-active-p)) (memq 'shift (event-modifiers last-input-event))) - (push-mark nil nil t))) + (let ((in-shifted-motion-command t)) + (push-mark nil nil t)))) (defun handle-post-motion-command () (if @@ -3276,6 +3354,10 @@ when it is off screen." element)) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; mail composition code ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (defcustom mail-user-agent 'sendmail-user-agent "*Your preference for a mail composition package. Various Emacs Lisp packages (e.g. reporter) require you to compose an @@ -3421,6 +3503,10 @@ Each action has the form (FUNCTION . ARGS)." 'switch-to-buffer-other-frame yank-action send-actions)) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; set variable ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (defun set-variable (var val) "Set VARIABLE to VALUE. VALUE is a Lisp object. When using this interactively, supply a Lisp expression for VALUE. @@ -3463,31 +3549,11 @@ it were the arg to `interactive' (which see) to interactively read the value." (if (and (boundp var) (specifierp (symbol-value var))) (set-specifier (symbol-value var) val) (set var val))) - -;; XEmacs -(defun activate-region () - "Activate the region, if `zmacs-regions' is true. -Setting `zmacs-regions' to true causes LISPM-style active regions to be used. -This function has no effect if `zmacs-regions' is false." - (interactive) - (and zmacs-regions (zmacs-activate-region))) -;; XEmacs -(defsubst region-exists-p () - "Return t if the region exists. -If active regions are in use (i.e. `zmacs-regions' is true), this means that - the region is active. Otherwise, this means that the user has pushed - a mark in this buffer at some point in the past. -The functions `region-beginning' and `region-end' can be used to find the - limits of the region." - (not (null (mark)))) - -;; XEmacs -(defun region-active-p () - "Return non-nil if the region is active. -If `zmacs-regions' is true, this is equivalent to `region-exists-p'. -Otherwise, this function always returns false." - (and zmacs-regions zmacs-region-extent)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; case changing code ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; A bunch of stuff was moved elsewhere: ;; completion-list-mode-map @@ -3565,12 +3631,42 @@ The words not capitalized are specified in `uncapitalized-title-words'." (forward-word 1)) (setq first nil)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; zmacs active region code ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Most of the zmacs code is now in elisp. The only thing left in C ;; are the variables zmacs-regions, zmacs-region-active-p and ;; zmacs-region-stays plus the function zmacs_update_region which ;; simply calls the lisp level zmacs-update-region. It must remain ;; for convenience, since it is called by core C code. +;; XEmacs +(defun activate-region () + "Activate the region, if `zmacs-regions' is true. +Setting `zmacs-regions' to true causes LISPM-style active regions to be used. +This function has no effect if `zmacs-regions' is false." + (interactive) + (and zmacs-regions (zmacs-activate-region))) + +;; XEmacs +(defsubst region-exists-p () + "Return t if the region exists. +If active regions are in use (i.e. `zmacs-regions' is true), this means that + the region is active. Otherwise, this means that the user has pushed + a mark in this buffer at some point in the past. +The functions `region-beginning' and `region-end' can be used to find the + limits of the region." + (not (null (mark)))) + +;; XEmacs +(defun region-active-p () + "Return non-nil if the region is active. +If `zmacs-regions' is true, this is equivalent to `region-exists-p'. +Otherwise, this function always returns false." + (and zmacs-regions zmacs-region-extent)) + (defvar zmacs-activate-region-hook nil "Function or functions called when the region becomes active; see the variable `zmacs-regions'.") @@ -3711,9 +3807,10 @@ when appropriate. Calling this function will call the hook (mark-marker t)))) (run-hooks 'zmacs-update-region-hook))) -;;;;;; -;;;;;; echo area stuff -;;;;;; + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; message logging code ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; #### Should this be moved to a separate file, for clarity? ;;; -hniksic @@ -4034,10 +4131,10 @@ See `display-message' for a list of standard labels." (display-message label str) str))) - -;;;;;; -;;;;;; warning stuff -;;;;;; + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; warning code ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defcustom log-warning-minimum-level 'info "Minimum level of warnings that should be logged. @@ -4239,6 +4336,11 @@ The C code calls this periodically, right before redisplay." (set-window-start (display-buffer buffer) warning-marker)) (set-marker warning-marker (point-max buffer) buffer))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; misc junk ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (defun emacs-name () "Return the printable name of this instance of Emacs." (cond ((featurep 'infodock) "InfoDock") diff --git a/lisp/subr.el b/lisp/subr.el index f306b44..fa38653 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -319,12 +319,6 @@ other hooks, such as major mode hooks, can do the job." The value of this variable may be buffer-local. The buffer about to be killed is current when this hook is run.") -;; called by Frecord_buffer() -(defvar record-buffer-hook nil - "Function or functions to be called when a buffer is recorded. -The value of this variable may be buffer-local. -The buffer being recorded is passed as an argument to the hook.") - ;; in C in FSFmacs (defvar kill-emacs-hook nil "Function or functions to be called when `kill-emacs' is called, @@ -728,6 +722,12 @@ If FUNCTION is not interactive, nil will be returned." (t (error "Non-funcallable object: %s" function)))) +(defun function-allows-args (function n) + "Return whether FUNCTION can be called with N arguments." + (and (<= (function-min-args function) n) + (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 diff --git a/lwlib/ChangeLog b/lwlib/ChangeLog index 2362b17..bba50dc 100644 --- a/lwlib/ChangeLog +++ b/lwlib/ChangeLog @@ -1,3 +1,43 @@ +2000-05-01 Martin Buchholz + + * XEmacs 21.2.33 is released. + +2000-04-19 Martin Buchholz + + * lwlib.c (lw_destroy_everything): Always use full ANSI prototypes. + * lwlib.c (lw_destroy_all_pop_ups): Always use full ANSI prototypes. + +2000-04-12 Andy Piper + + * lwlib-Xaw.c (xaw_update_one_widget): no-op for text widgets. + (xaw_update_one_value): Get strings safely. + (xaw_create_text_field): add some extra properties. + +2000-04-05 Andy Piper + + * lwlib-Xaw.c (lw_xaw_widget_p): include asciiTextWidgetClass as + an athena widget. + +2000-04-05 Andy Piper + + * xlwradio.c (RadioSetValues): resize if position information has + changed. + + * lwlib-Xm.c (xm_create_text_field): text fields should be enabled + even if there is no callback. + * lwlib-Xaw.c (xaw_create_text_field): ditto. + +2000-04-03 Andy Piper + + * lwlib.c (merge_widget_value_args): only merge when the two args + are actually different. + +2000-03-21 Didier Verna + + * config.h.in: move INCLUDE_GLUE_1 and INCLUDE_GLUE_2 to + src/config.h.in. + * config.h.in (ATHENA_INCLUDE): use the `SMART_INCLUDE' macro. + 2000-03-20 Martin Buchholz * XEmacs 21.2.32 is released. diff --git a/lwlib/config.h.in b/lwlib/config.h.in index af8ab48..7537c20 100644 --- a/lwlib/config.h.in +++ b/lwlib/config.h.in @@ -31,17 +31,10 @@ Boston, MA 02111-1307, USA. */ /* The path to the Athena widgets - the usual value is `X11/Xaw' */ #undef ATHENA_H_PATH - -/* For use in #include statements. - You can't use macros directly within the <> of a #include statement. - The multiply nested macros are necessary to make old gcc's happy. - However, those nested macros are too much for AIX xlc to deal with. */ -#if defined(_AIX) && !defined(__GNUC__) -#define ATHENA_INCLUDE(header_file) +#ifdef ATHENA_H_PATH +# define ATHENA_INCLUDE(file) SMART_INCLUDE (ATHENA_H_PATH,file) #else -#define INCLUDE_GLUE_2(dirname,basename) <##dirname##/##basename##> -#define INCLUDE_GLUE_1(dirname,basename) INCLUDE_GLUE_2(dirname,basename) -#define ATHENA_INCLUDE(header_file) INCLUDE_GLUE_1(ATHENA_H_PATH,header_file) +# define ATHENA_INCLUDE(file) #endif #endif /* _LWLIB_CONFIG_H_ */ diff --git a/lwlib/lwlib-Xaw.c b/lwlib/lwlib-Xaw.c index c51522c..4cf14de 100644 --- a/lwlib/lwlib-Xaw.c +++ b/lwlib/lwlib-Xaw.c @@ -69,8 +69,8 @@ lw_xaw_widget_p (Widget widget) || XtIsSubclass (widget, labelWidgetClass) || XtIsSubclass (widget, toggleWidgetClass) || XtIsSubclass (widget, gaugeWidgetClass) -#if 0 - || XtIsSubclass (widget, textWidgetClass) +#ifndef NEED_MOTIF + || XtIsSubclass (widget, asciiTextWidgetClass) #endif #endif ); @@ -134,6 +134,13 @@ xaw_update_one_widget (widget_instance *instance, Widget widget, xaw_update_scrollbar (instance, widget, val); } #endif +#ifdef LWLIB_WIDGETS_ATHENA +#ifndef NEED_MOTIF + else if (XtIsSubclass (widget, asciiTextWidgetClass)) + { + } +#endif +#endif #ifdef LWLIB_DIALOGS_ATHENA else if (XtIsSubclass (widget, dialogWidgetClass)) { @@ -220,11 +227,19 @@ xaw_update_one_value (widget_instance *instance, Widget widget, #ifndef NEED_MOTIF else if (XtIsSubclass (widget, asciiTextWidgetClass)) { - Arg al [1]; + Arg al [2]; + String buf = 0; + XtSetArg (al [0], XtNstring, &buf); + XtGetValues (widget, al, 2); + if (val->value) - free (val->value); - XtSetArg (al [0], XtNstring, &val->value); - XtGetValues (widget, al, 1); + { + free (val->value); + val->value = 0; + } + /* I don't think this causes a leak. */ + if (buf) + val->value = strdup (buf); val->edited = True; } #endif @@ -821,6 +836,7 @@ xaw_create_progress (widget_instance *instance) } #ifndef NEED_MOTIF +#define TEXT_BUFFER_SIZE 128 static Widget xaw_create_text_field (widget_instance *instance) { @@ -829,22 +845,36 @@ xaw_create_text_field (widget_instance *instance) Widget text = 0; widget_value* val = instance->info->val; - XtSetArg (al [ac], XtNsensitive, val->enabled && val->call_data); ac++; + XtSetArg (al [ac], XtNsensitive, val->enabled); ac++; XtSetArg (al [ac], XtNmappedWhenManaged, FALSE); ac++; XtSetArg (al [ac], XtNhighlightThickness, (Dimension)0); ac++; XtSetArg (al [ac], XtNtype, XawAsciiString); ac++; XtSetArg (al [ac], XtNeditType, XawtextEdit); ac++; + XtSetArg (al [ac], XtNuseStringInPlace, False); ac++; +#if 0 + XtSetArg (al [ac], XtNlength, TEXT_BUFFER_SIZE); ac++; +#endif + if (val->value) + { + XtSetArg (al [ac], XtNstring, val->value); ac++; + } /* add any args the user supplied for creation time */ lw_add_value_args_to_args (val, al, &ac); text = XtCreateManagedWidget (val->name, asciiTextWidgetClass, instance->parent, al, ac); + + /* add the callback */ + if (val->call_data) + XtAddCallback (text, XtNgetValue, xaw_generic_callback, (XtPointer)instance); + XtManageChild (text); return text; } #endif + #endif /* LWLIB_WIDGETS_ATHENA */ widget_creation_entry diff --git a/lwlib/lwlib-Xm.c b/lwlib/lwlib-Xm.c index 76d893d..410af34 100644 --- a/lwlib/lwlib-Xm.c +++ b/lwlib/lwlib-Xm.c @@ -1688,7 +1688,7 @@ xm_create_text_field (widget_instance *instance) Widget text = 0; widget_value* val = instance->info->val; - XtSetArg (al [ac], XmNsensitive, val->enabled && val->call_data); ac++; + XtSetArg (al [ac], XmNsensitive, val->enabled); ac++; XtSetArg (al [ac], XmNalignment, XmALIGNMENT_BEGINNING); ac++; XtSetArg (al [ac], XmNuserData, val->call_data); ac++; XtSetArg (al [ac], XmNmappedWhenManaged, FALSE); ac++; diff --git a/lwlib/lwlib.c b/lwlib/lwlib.c index 27f7a08..062a452 100644 --- a/lwlib/lwlib.c +++ b/lwlib/lwlib.c @@ -257,7 +257,7 @@ merge_widget_value_args (widget_value *old, widget_value *new) lw_copy_widget_value_args (old, new); changed = True; } - else if (new->args && old->args) + else if (new->args && old->args && new->args != old->args) { /* #### Do something more sensible here than just copying the new values (like actually merging the values). */ @@ -1048,14 +1048,14 @@ lw_destroy_all_widgets (LWLIB_ID id) } void -lw_destroy_everything () +lw_destroy_everything (void) { while (all_widget_info) lw_destroy_all_widgets (all_widget_info->id); } void -lw_destroy_all_pop_ups () +lw_destroy_all_pop_ups (void) { widget_info *info; widget_info *next; diff --git a/man/ChangeLog b/man/ChangeLog index 0ec892f..41ff8e5 100644 --- a/man/ChangeLog +++ b/man/ChangeLog @@ -1,3 +1,18 @@ +2000-05-01 Martin Buchholz + + * XEmacs 21.2.33 is released. + +2000-04-11 Yoshiki Hayashi + + * xemacs-faq.texi (Q2.1.24): Removed wrong header. + +2000-04-01 Oscar Figueiredo + + * lispref/ldap.texi: Documentation of the add/modify/delete and + internationalization APIs + + * lispref/lispref.texi: Updated LDAP-related menus + 2000-03-20 Martin Buchholz * XEmacs 21.2.32 is released. diff --git a/man/lispref/ldap.texi b/man/lispref/ldap.texi index 9195a2b..6e9c686 100644 --- a/man/lispref/ldap.texi +++ b/man/lispref/ldap.texi @@ -25,7 +25,7 @@ linking to an external LDAP client library. As of 21.2, XEmacs has been successfully built and tested with @itemize @bullet -@item OpenLDAP 1.0.3 (@url{http://www.openldap.org/}) +@item OpenLDAP 1.2 (@url{http://www.openldap.org/}) @item University of Michigan's LDAP 3.3 (@url{http://www.umich.edu/~dirsvcs/ldap/}) @item LDAP SDK 1.0 from Netscape Corp. (@url{http://developer.netscape.com/}) @end itemize @@ -33,7 +33,7 @@ successfully built and tested with Other libraries conforming to RFC 1823 will probably work also but may require some minor tweaking at C level. -The standard XEmacs configure script autodetects an installed LDAP +The standard XEmacs configure script auto-detects an installed LDAP library provided the library itself and the corresponding header files can be found in the library and include paths. A successful detection will be signalled in the final output of the configure script. @@ -49,13 +49,18 @@ to stay as close as possible to the C API (where practical) and a higher-level layer which provides more convenient primitives to effectively use LDAP. -As of XEmacs 21.0, only interfaces to basic LDAP search functions are -provided, broader support is planned in future versions. +The low-level API should be used directly for very specific purposes +(such as multiple operations on a connection) only. The higher-level +functions provide a more convenient way to access LDAP directories +hiding the subtleties of handling the connection, translating arguments +and ensuring compliance with LDAP internationalization rules and formats +(currently partly implemented only). @menu * LDAP Variables:: Lisp variables related to LDAP * The High-Level LDAP API:: High-level LDAP lisp functions * The Low-Level LDAP API:: Low-level LDAP lisp primitives +* LDAP Internationalization:: I18n variables and functions @end menu @@ -77,7 +82,7 @@ Initialized from the LDAP library. Default value is 389. @defvar ldap-default-base Default base for LDAP searches. This is a string using the syntax of RFC 1779. -For instance, "o¬ME, cÿ" limits the search to the +For instance, "o=ACME, c=US" limits the search to the Acme organization in the United States. @end defvar @@ -92,7 +97,7 @@ properties: @table @code @item binddn The distinguished name of the user to bind as. This may look like -@samp{cÿ, o¬me, cnÿnny Bugs}, see RFC 1779 for details. +@samp{cn=Babs Jensen,o=ACME,c=US}, see RFC 1779 for details. @item passwd The password to use for authentication. @item auth @@ -127,41 +132,99 @@ The maximum number of matches to return for searches performed on this connectio @end table @end defvar +@defvar ldap-verbose +If non-@code{nil}, LDAP operations will echo progress messages. Defaults to @code{nil}. +@end defvar @node The High-Level LDAP API, The Low-Level LDAP API, LDAP Variables, XEmacs LDAP API @comment node-name, next, previous, up @subsection The High-Level LDAP API -As of this writing the high-level Lisp LDAP API only provides for LDAP -searches. Further support is planned in the future. - -The @code{ldap-search} function provides the most convenient interface -to perform LDAP searches. It opens a connection to a host, performs the -query and cleanly closes the connection thus insulating the user from -all the details of the low-level interface such as LDAP Lisp objects -@pxref{The Low-Level LDAP API} - -@defun ldap-search filter &optional host attributes attrsonly +The following functions provide the most convenient interface to perform +LDAP operations. All of them open a connection to a host, perform an +operation (add/search/modify/delete) on one or several entries and +cleanly close the connection thus insulating the user from all the +details of the low-level interface such as LDAP Lisp objects @pxref{The +Low-Level LDAP API}. + +Note that @code{ldap-search} which used to be the name of the high-level +search function in XEmacs 21.1 is now obsolete. For consistency in the +naming as well as backward compatibility, that function now acts as a +wrapper that calls either @code{ldap-search-basic} (low-level search +function) or @code{ldap-search-entries} (high-level search function) +according to the actual parameters. A direct call to one of these two +functions is preferred since it is faster and unambiguous. + +@defun ldap-search-entries filter &optional host attributes attrsonly withdn Perform an LDAP search. @var{filter} is the search filter @pxref{Syntax of Search Filters} -@var{host} is the LDAP host on which to perform the search +@var{host} is the LDAP host on which to perform the search. @var{attributes} is the specific attributes to retrieve, @code{nil} means -retrieve all +retrieve all. @var{attrsonly} if non-@code{nil} retrieves the attributes only without their associated values. +If @var{withdn} is non-@code{nil} each entry in the result will be prepended with +its distinguished name DN. Additional search parameters can be specified through @code{ldap-host-parameters-alist}. +The function returns a list of matching entries. Each entry is itself +an alist of attribute/value pairs optionally preceded by the DN of the +entry according to the value of @var{withdn}. +@end defun + +@defun ldap-add-entries entries &optional host binddn passwd +Add entries to an LDAP directory. @var{entries} is a list of entry +specifications of the form @code{(DN (ATTR . VALUE) (ATTR . VALUE) ...)} +where @var{dn} the distinguished name of an entry to add, the following +are cons cells containing attribute/value string pairs. @var{host} is +the LDAP host, defaulting to `ldap-default-host' @var{binddn} is the DN +to bind as to the server @var{passwd} is the corresponding password. +@end defun + +@defun ldap-modify-entries entry-mods &optional host binddn passwd +Modify entries of an LDAP directory. +@var{entry_mods} is a list of entry modifications of the form +@code{(DN MOD-SPEC1 MOD-SPEC2 ...)} where @var{dn} is the distinguished name of +the entry to modify, the following are modification specifications. +A modification specification is itself a list of the form +@code{(MOD-OP ATTR VALUE1 VALUE2 ...)} @var{mod-op} and @var{attr} are mandatory, +@var{values} are optional depending on @var{mod-op}. +@var{mod-op} is the type of modification, one of the symbols @code{add}, @code{delete} +or @code{replace}. @var{attr} is the LDAP attribute type to modify. +@var{host} is the LDAP host, defaulting to @code{ldap-default-host} +@var{binddn} is the DN to bind as to the server +@var{passwd} is the corresponding password" @end defun -@node The Low-Level LDAP API, , The High-Level LDAP API, XEmacs LDAP API +@defun ldap-delete-entries dn &optional host binddn passwd +Delete an entry from an LDAP directory. +@var{dn} is the distinguished name of an entry to delete or +a list of those. +@var{host} is the LDAP host, defaulting to @code{ldap-default-host} +@var{binddn} is the DN to bind as to the server +@var{passwd} is the corresponding password. +@end defun + + +@node The Low-Level LDAP API, LDAP Internationalization, The High-Level LDAP API, XEmacs LDAP API @comment node-name, next, previous, up @subsection The Low-Level LDAP API +The low-level API should be used directly for very specific purposes +(such as multiple operations on a connection) only. The higher-level +functions provide a more convenient way to access LDAP directories +hiding the subtleties of handling the connection, translating arguments +and ensuring compliance with LDAP internationalization rules and formats +(currently partly implemented only). See @pxref{The High-Level LDAP API} + +Note that the former functions @code{ldap-*-internal} functions have been +renamed in XEmacs 21.2 + @menu * The LDAP Lisp Object:: * Opening and Closing a LDAP Connection:: -* Searching on a LDAP Server (Low-level):: +* Low-level Operations on a LDAP Server:: @end menu @node The LDAP Lisp Object, Opening and Closing a LDAP Connection, The Low-Level LDAP API, The Low-Level LDAP API @@ -184,7 +247,7 @@ Return non-@code{nil} if @var{ldap} is an active LDAP connection @end defun -@node Opening and Closing a LDAP Connection, Searching on a LDAP Server (Low-level), The LDAP Lisp Object, The Low-Level LDAP API +@node Opening and Closing a LDAP Connection, Low-level Operations on a LDAP Server, The LDAP Lisp Object, The Low-Level LDAP API @comment node-name, next, previous, up @subsubsection Opening and Closing a LDAP Connection @@ -202,7 +265,7 @@ library XEmacs was compiled with, they may include @code{simple}, @code{krbv41} and @code{krbv42}. @item binddn The distinguished name of the user to bind as. This may look like -@samp{cÿ, o¬me, cnÿnny Bugs}, see RFC 1779 for details. +@samp{c=com, o=Acme, cn=Babs Jensen}, see RFC 1779 for details. @item passwd The password to use for authentication. @item deref @@ -232,18 +295,17 @@ Close the connection represented by @var{ldap} @end defun -@node Searching on a LDAP Server (Low-level), , Opening and Closing a LDAP Connection, The Low-Level LDAP API +@node Low-level Operations on a LDAP Server, , Opening and Closing a LDAP Connection, The Low-Level LDAP API @comment node-name, next, previous, up -@subsubsection Searching on a LDAP Server (Low-level) +@subsubsection Low-level Operations on a LDAP Server -@code{ldap-search-internal} is the low-level primitive to perform a +@code{ldap-search-basic} is the low-level primitive to perform a search on a LDAP server. It works directly on an open LDAP connection thus requiring a preliminary call to @code{ldap-open}. Multiple searches can be made on the same connection, then the session must be closed with @code{ldap-close}. - -@defun ldap-search-internal ldap filter base scope attrs attrsonly +@defun ldap-search-basic ldap filter base scope attrs attrsonly Perform a search on an open connection @var{ldap} created with @code{ldap-open}. @var{filter} is a filter string for the search @pxref{Syntax of Search Filters} @var{base} is the distinguished name at which to start the search. @@ -255,11 +317,137 @@ object, to a single level or to the whole subtree. The default is for each matching entry. If @code{nil} all available attributes are returned. If @code{attrsonly} is non-@code{nil} then only the attributes are retrieved, not their associated values -The function returns a list of matching entries. Each entry being itself -an alist of attribute/values. +If @code{withdn} is non-@code{nil} then each entry in the result is prepended with +its distinguished name DN +If @code{verbose} is non-@code{nil} then progress messages are echoed +The function returns a list of matching entries. Each entry is itself +an alist of attribute/value pairs optionally preceded by the DN of the +entry according to the value of @code{withdn}. +@end defun + +@defun ldap-add ldap dn entry +Add @var{entry} to a LDAP directory which a connection @var{ldap} has +been opened to with @code{ldap-open}. +@var{dn} is the distinguished name of the entry to add. +@var{entry} is an entry specification, i.e., a list of cons cells +containing attribute/value string pairs. +@end defun + +@defun ldap-modify ldap dn mods +Modify an entry in an LDAP directory. +@var{ldap} is an LDAP connection object created with @code{ldap-open}. +@var{dn} is the distinguished name of the entry to modify. +@var{mods} is a list of modifications to apply. +A modification is a list of the form @code{(MOD-OP ATTR VALUE1 VALUE2 ...)} +@var{mod-op} and @var{attr} are mandatory, @var{values} are optional depending on @var{mod-op}. +@var{mod-op} is the type of modification, one of the symbols @code{add}, @code{delete} +or @code{replace}. @var{attr} is the LDAP attribute type to modify +@end defun + +@defun ldap-delete ldap dn +Delete an entry to an LDAP directory. +@var{ldap} is an LDAP connection object created with @code{ldap-open}. +@var{dn} is the distinguished name of the entry to delete +@end defun + + + +@node LDAP Internationalization, , The Low-Level LDAP API, XEmacs LDAP API +@comment node-name, next, previous, up +@subsection LDAP Internationalization + +The XEmacs LDAP API provides basic internationalization features based +on the LDAP v3 specification (essentially RFC2252 on "LDAP v3 Attribute +Syntax Definitions"). Unfortunately since there is currently no free +LDAP v3 server software, this part has not received much testing and +should be considered experimental. The framework is in place though. + +@defun ldap-decode-attribute attr +Decode the attribute/value pair @var{attr} according to LDAP rules. +The attribute name is looked up in @code{ldap-attribute-syntaxes-alist} +and the corresponding decoder is then retrieved from +@code{ldap-attribute-syntax-decoders}' and applied on the value(s). +@end defun + +@menu +* LDAP Internationalization Variables:: +* Encoder/Decoder Functions:: +@end menu + +@node LDAP Internationalization Variables, Encoder/Decoder Functions, LDAP Internationalization, LDAP Internationalization +@comment node-name, next, previous, up +@subsubsection LDAP Internationalization Variables + +@defvar ldap-ignore-attribute-codings +If non-@code{nil}, no encoding/decoding will be performed LDAP attribute values +@end defvar + +@defvar ldap-coding-system +Coding system of LDAP string values. +LDAP v3 specifies the coding system of strings to be UTF-8. +You need an XEmacs with Mule support for this. +@end defvar + +@defvar ldap-default-attribute-decoder +Decoder function to use for attributes whose syntax is unknown. Such a +function receives an encoded attribute value as a string and should +return the decoded value as a string +@end defvar + +@defvar ldap-attribute-syntax-encoders +A vector of functions used to encode LDAP attribute values. +The sequence of functions corresponds to the sequence of LDAP attribute syntax +object identifiers of the form 1.3.6.1.4.1.1466.1115.121.1.* as defined in +RFC2252 section 4.3.2. As of this writing, only a few encoder functions +are available. +@end defvar + +@defvar ldap-attribute-syntax-decoders +A vector of functions used to decode LDAP attribute values. +The sequence of functions corresponds to the sequence of LDAP attribute syntax +object identifiers of the form 1.3.6.1.4.1.1466.1115.121.1.* as defined in +RFC2252 section 4.3.2. As of this writing, only a few decoder functions +are available. +@end defvar + +@defvar ldap-attribute-syntaxes-alist +A map of LDAP attribute names to their type object id minor number. +This table is built from RFC2252 Section 5 and RFC2256 Section 5 +@end defvar + +@node Encoder/Decoder Functions, , LDAP Internationalization Variables, LDAP Internationalization +@comment node-name, next, previous, up +@subsubsection Encoder/Decoder Functions + +@defun ldap-encode-boolean bool +A function that encodes an elisp boolean @var{bool} into a LDAP +boolean string representation +@end defun + +@defun ldap-decode-boolean str +A function that decodes a LDAP boolean string representation +@var{str} into an elisp boolean +@end defun + +@defun ldap-decode-string str +Decode a string @var{str} according to `ldap-coding-system' @end defun +@defun ldap-encode-string str +Encode a string @var{str} according to `ldap-coding-system' +@end defun + +@defun ldap-decode-address str +Decode an address @var{str} according to `ldap-coding-system' and +replacing $ signs with newlines as specified by LDAP encoding rules for +addresses +@end defun +@defun ldap-encode-address str +Encode an address @var{str} according to `ldap-coding-system' and +replacing newlines with $ signs as specified by LDAP encoding rules for +addresses +@end defun @@ -299,6 +487,3 @@ not operators. matches records of class @code{Person} containing a @code{mail} attribute and corresponding to people whose last name is @code{Smith} or whose first name is @code{John}. - - - diff --git a/man/lispref/lispref.texi b/man/lispref/lispref.texi index ac6277b..19e4b5a 100644 --- a/man/lispref/lispref.texi +++ b/man/lispref/lispref.texi @@ -1099,12 +1099,18 @@ XEmacs LDAP API * LDAP Variables:: Lisp variables related to LDAP * The High-Level LDAP API:: High-level LDAP lisp functions * The Low-Level LDAP API:: Low-level LDAP lisp primitives +* LDAP Internationalization:: I18n variables and functions The Low-Level LDAP API * The LDAP Lisp Object:: * Opening and Closing a LDAP Connection:: -* Searching on a LDAP Server (Low-level):: +* Low-level Operations on a LDAP Server:: + +LDAP Internationalization + +* LDAP Internationalization Variables:: +* Encoder/Decoder Functions:: Internationalization diff --git a/man/xemacs-faq.texi b/man/xemacs-faq.texi index 5b62a19..5d57229 100644 --- a/man/xemacs-faq.texi +++ b/man/xemacs-faq.texi @@ -7,7 +7,7 @@ @finalout @titlepage @title XEmacs FAQ -@subtitle Frequently asked questions about XEmacs @* Last Modified: $Date: 2000/03/07 09:19:02 $ +@subtitle Frequently asked questions about XEmacs @* Last Modified: $Date: 2000/04/26 07:18:27 $ @sp 1 @author Tony Rossini @author Ben Wing @@ -2491,7 +2491,6 @@ and uncomment the line that reads: @node Q2.1.24, , Q2.1.23, Installation @unnumberedsubsec Q2.1.24: XEmacs won't start without network. (NEW) -Q2.1.23: Movemail on Linux does not work for XEmacs 19.15 and later. If XEmacs starts when you're on the network, but fails when you're not on the network, you may be missing a "localhost" entry in your diff --git a/nt/ChangeLog b/nt/ChangeLog index e7ec435..b8bbb4d 100644 --- a/nt/ChangeLog +++ b/nt/ChangeLog @@ -1,3 +1,77 @@ +2000-05-01 Martin Buchholz + + * XEmacs 21.2.33 is released. + +2000-04-27 Ben Wing + + * xemacs.mak: combine auto-autoloads.el and custom.el update into + one call to xemacs. + +2000-04-26 Ben Wing + + * xemacs.mak: put in support for QUICK_BUILD. + + * config.inc.samp: put in an entry for QUICK_BUILD. + +2000-04-23 Ben Wing + + * xemacs.mak: Modified section that dumps .exe to not dump + when nothing has changed. It does this by relying on a flag + set by update-elcs. + + Also in building of auto-autoloads.el, we no longer unconditionally + remove the old one. That was pointless and made the whole build + procedure a lot longer -- the autoload code is smart enough to + update itself automatically from an out-of-date autoload file. + +2000-04-04 Kirill 'Big K' Katsnelson + + * xemacs.mak: Build the i utility and use it to pipe windowed + [xt]emacs output to the build console. + +2000-03-25 Didier Verna + + * config.h: handle the renaming of `foo_h_path' to `foo_h_file'. + +2000-03-22 Mike Alexander + + * xemacs.mak (PROGRAM_DEFINES): Define EMACS_VERSION and + EMACS_PROGNAME + (DEPEND): Don't try to create $(OUTDIR) if it already exists + ($(SRC)\dump-id.c): Make it + (DOC_SRC11): Add dumper.c if portable dumping + (dump-xemacs): Make portable dumping work again and create + dump-id.c and compile it whenever we do a portable dump. + (depend): Change $(SRCDIR) to $(SRC) + +2000-03-22 Jonathan Harris + + * .cvsignore: New file, ignores user's config.inc and files + containing the user's DevStudio workspace info. + + * config.h.samp: Added DEPEND option. Renamed HAVE_MSW and HAVE_X to + HAVE_MS_WINDOWS and HAVE_X_WINDOWS. + + * README: Documented DEPEND option. Other small changes. + + * Todo: Removed - was hopelessly out of date. + + * config.h.samp: + * xemacs.mak: Added DEPEND option to control use of dependency + information generated by make-src-depend. Requires Perl. Defaults + to disabled. Renamed HAVE_MSW and HAVE_X to HAVE_MS_WINDOWS and + HAVE_X_WINDOWS as a side-effect. + Handles '&' in XEmacs codenames by replacing with 'and'. + + * xemacs.dsp: + Correct Output_Dir so that DevStudio finds the xemacs executable + by default. + +2000-03-20 Ben Wing + + * README: Substantial rewrite. + * xemacs.mak: Pdump fix. (not working yet, though) + 2000-03-20 Martin Buchholz * XEmacs 21.2.32 is released. @@ -18,12 +92,12 @@ 2000-03-12 Ben Wing - * xemacs.mak (*): + * xemacs.mak (*): * config.inc: New. a) Added a file called config.inc which makes it easier to set build options for MS Windows. (Previously, the only way to do this - was through command line options to nmake.) + was through command line options to nmake.) b) Cleaned the file up a bit. @@ -36,7 +110,7 @@ * xemacs.dsp: New. For compiling, editing, and debugging XEmacs using the VC++ 5.0 GUI. They may well work under other versions of VC++, but I don't - have access to them to test them. + have access to them to test them. 2000-03-11 Andy Piper @@ -191,7 +265,7 @@ * xemacs.mak (SRCDIR): Make path to xemacs absolute to facilitate building info in man subdirs. Echo all cd commands, - not just some of them. + not just some of them. (makeinfo-test): Test for availability of `texinfo' package to build info. Recommend use of external `makeinfo' program for @@ -274,7 +348,7 @@ 1999-06-05 Norbert Koch * xemacs.mak (mule): remove dependencies from mule-coding.c - + 1999-06-11 XEmacs Build Bot * XEmacs 21.2.16 is released @@ -293,7 +367,7 @@ 1999-05-31 Andy Piper * xemacs.mak: add select & select-x targets. - + 1999-05-14 XEmacs Build Bot * XEmacs 21.2.14 is released @@ -324,9 +398,9 @@ report" did. 1999-04-29 Andy Piper - + * sys/file.h: conditionalise definition of X_OK. - + 1999-03-12 XEmacs Build Bot * XEmacs 21.2.13 is released @@ -415,7 +489,7 @@ 1998-12-13 Jonathan Harris * xemacs.mak: - Replaced PACKAGEPATH variable with PACKAGE_PREFIX. + Replaced PACKAGEPATH variable with PACKAGE_PREFIX. configure-package-path is initialised to contain subdirectories of PACKAGE_PREFIX. The install target makes a skeleton package tree under PACKAGE_PREFIX. @@ -454,7 +528,7 @@ 1998-12-07 Martin Buchholz * xemacs.mak (TEMACS_OBJS): - (DOC_SRC4): + (DOC_SRC4): - Remove pure.c, pure.obj 1998-11-04 Adrian Aichner @@ -529,7 +603,7 @@ * xemacs.mak: change "copy" to "xcopy" in install target -1998-08-04 Jeff Sparkes +1998-08-04 Jeff Sparkes * xemacs.mak: Link in PNG, TIFF and JPEG in native build. @@ -637,9 +711,9 @@ 1998-05-20 Kirill M. Katsnelson - * xemacs.mak: Unified -nologo compiler switch handling and lib-src + * xemacs.mak: Unified -nologo compiler switch handling and lib-src programs build (only make-docfile currently, adding other tools - soon). + soon). 1998-05-23 Kirill M. Katsnelson @@ -713,7 +787,7 @@ 1998-04-10 Kirill M. Katsnelson * config.h: Do not USE_ASSERTION when DEBUG_XEMACS is not - defined. + defined. * xemacs.mak: Added new file process-nt.c @@ -767,7 +841,7 @@ 1998-03-19 Kirill M. Katsnelson - * xemacs.mak: HAVE_FILE_CODING removed: it is no longer an option, + * xemacs.mak: HAVE_FILE_CODING removed: it is no longer an option, since file I/O depends on it, and defined unconditioanlly in src/s/windowsnt.h. Added -nologo switch to different tools here and there. @@ -832,7 +906,7 @@ Mon December 08 1997 kkm@kis.ru * config.h: removed #define HAVE_UNIXOID_EVENT_LOOP Thu December 04 1997 jhar@tardis.ed.ac.uk - + * xemacs.mak: Define DEBUG_XEMACS when compiling with debug. Tue November 29 12:29:33 1997 davidh @@ -850,14 +924,14 @@ Mon December 01 1997 jhar - Rewrote timeout code, eliminating "!NILP(rest)" bug. - Special processing for 'Ctrl-@' keystroke. - Support for some new keysyms. - + Mon December 01 1997 jhar * xemacs.mak: - Add PACKAGE_PATH and EMACS_BETA_VERSION defines. - Automatically copy changed include files from \nt to \src. - Corrected some DOC_SRC* lists. - + Tue November 18 21:45:06 1997 davidh * xemacs.mak updated to remove dependency on startup.elc @@ -866,7 +940,7 @@ Tue November 18 21:45:06 1997 davidh Thu September 25 23:06:44 1997 davidh * xemacs.mak updated to make the build as simple as typing - nmake -f xemacs.mak. Also support for native gui included + nmake -f xemacs.mak. Also support for native gui included which should mean the w32 directory is no longer required. * config.h synced with config.h.in from 20.3-b2 @@ -876,7 +950,7 @@ Thu September 25 23:06:44 1997 davidh Thu September 25 23:06:44 1997 davidh * August Hill provided a patch to xemacs.mak to greatly simplify - the build - the DOC file gets created correctly. + the build - the DOC file gets created correctly. Tue September 22 23:06:44 1997 davidh @@ -902,7 +976,7 @@ Thu June 31 21:16:21 1997 davidh * nt/TODO created. * nt/X11.patch created to help with the X build. - + * August Hill provided: a patch to fix the _WRETCODE undefined symbol, a patch to fix a problem with dired @@ -915,7 +989,7 @@ Thu June 31 21:16:21 1997 davidh use the macro, I decided this would be easiest. * Modified src/fileio.c to only open files in O_BINARY. This - causes files to be opened and written without automatically + causes files to be opened and written without automatically writing ^M 's to the end of each line. MULE ought to sort this in theory, but I am less than convinced. @@ -956,7 +1030,7 @@ Sun Mar 16 00:32:15 1997 marcpa (marcpa at MARCPA) Thu Mar 13 00:19:25 1997 marcpa (marcpa at MARCPA) - * At end of compilation, there are some unresolved symbols: + * At end of compilation, there are some unresolved symbols: link.exe @C:\TEMP\nma00115. sysdep.obj : error LNK2001: unresolved external symbol _vfork @@ -983,12 +1057,11 @@ Wed Mar 12 23:18:53 1997 marcpa (marcpa at MARCPA) @@ -150,8 +150,9 @@ typedef CARD16 BITS16; typedef CARD8 BYTE; - + +#ifndef WIN32 typedef CARD8 BOOL; - +#endif * cpp.exe not used: cl.exe from VC++4.2 seems to handle everything - properly. - + properly. diff --git a/nt/README b/nt/README index 67c6889..62ad352 100644 --- a/nt/README +++ b/nt/README @@ -1,12 +1,12 @@ -Building and Installing XEmacs on Windows NT -*- mode:outline -*- +Building and Installing XEmacs on Windows 95/98/NT -*- mode:outline -*- David Hobley - Marc Paquette - Jonathan Harris + Marc Paquette + Jonathan Harris + Ben Wing -The port was made much easier by the groundbreaking work of Geoff Voelker -and others who worked on the GNU Emacs port to NT. Their version is available -from http://www.cs.washington.edu/homes/voelker/ntemacs.html +This is a port of XEmacs to Windows 95/98/NT. If you are looking for a port +of GNU Emacs, see http://www.cs.washington.edu/homes/voelker/ntemacs.html. * Required tools and sources @@ -24,17 +24,30 @@ from http://www.cs.washington.edu/homes/voelker/ntemacs.html c:\Program Files\DevStudio\VC\bin\ (or wherever you installed it) that you can run before building to set up all of these environment variables. -2. Grab the latest XEmacs source from ftp.xemacs.org if necessary. +2. Grab the latest XEmacs source from - You'll also need the xemacs-base package from the binary-packages - subdirectory and you'll probably also want at least the edit-utils, - text-modes, fsf-compat, cc-mode, prog-modes and xemacs-devel - packages. + ftp://ftp.xemacs.org/pub/xemacs/ + + or one of its mirrors listed at http://www.xemacs.org/Download/index.html . + + You'll also need the packages. You probably want to get the unified + packages bundle from - You'll also need the texinfo package unless you have a copy of - makeinfo.exe on your machine. + ftp://ftp.xemacs.org/pub/xemacs/packages/xemacs-sumo.tar.gz + + Although we don't recommend it, you can also retrieve just the packages + you really need if you have an extremely slow net connection or are very + short on disk space. You can find the various packages in + ftp://ftp.xemacs.org/pub/xemacs/packages/. You will need the + xemacs-base package. You'll also need the texinfo package unless you + have a copy of makeinfo.exe on your machine. If you want to download + additional or updated packages from within XEmacs you'll need the efs, + dired and vm packages. You'll probably also want at least the + edit-utils, text-modes, fsf-compat, cc-mode, prog-modes and xemacs-devel + packages. - Unpack the packages into, say, "c:\Program Files\XEmacs\xemacs-packages". + Unpack the packages into "x:\your\choice\XEmacs\xemacs-packages", + for example "c:\Program Files\XEmacs\xemacs-packages". 3. At this point you can choose to build for X and/or for Win32 native GUI. If you only want to build for the Win32 native GUI then skip the next @@ -45,8 +58,8 @@ from http://www.cs.washington.edu/homes/voelker/ntemacs.html If you want support for X you will also need: -1. An X server. MI/X is available on the Internet for free; It is - available from: http://www.microimages.com/www/html/freestuf/mixdlfrm.htm +1. An X server. MI/X is available on the Internet as trialware; it is + available from: http://www.microimages.com/www/html/mix/ 2. Source for the MIT X11R6.3 libraries, available from: ftp.x.org @@ -64,15 +77,17 @@ If you want support for X you will also need: * Optional libraries ==================== -1. If you want XPM image and toolbar support grab the latest version of the - xpm sources (xpm-3.4k.tar.gz at time of writing) and unpack them somewhere. +1. You really want the XPM library. Grab the latest version of the + xpm sources (xpm-3.4k.tar.gz at time of writing) from + ftp://ftp.xemacs.org/pub/xemacs/aux/ and unpack them somewhere. Copy nt\xpm.mak from the xemacs sources to the lib subdirectory of the xpm sources, cd to that directory and build xpm with 'nmake -f xpm.mak'. 2. You probably also want PNG image support. Grab the latest versions of zlib - and libpng (zlib-1.1.3 and libpng-1.0.2 at time of writing), unpack them - somewhere and read the respective READMEs for details on how to build them. - The following build procedure works for zlib-1.1.3 and libpng-1.0.2: + and libpng (zlib-1.1.3 and libpng-1.0.2 at time of writing) from + ftp://ftp.xemacs.org/pub/xemacs/aux/, unpack them somewhere and read + the respective READMEs for details on how to build them. The following + build procedure works for zlib-1.1.3 and libpng-1.0.2: cd to the zlib directory, type 'copy msdos\makefile.w32 Makefile' and then type 'nmake'. @@ -81,116 +96,161 @@ If you want support for X you will also need: and type 'nmake -f scripts\makefile.w32'. 3. If you want TIFF support, grap the latest version of libtiff (tiff-v3.4 - at time of writing) and unpack it somewhere. Copy nt\tiff.mak from the - xemacs sources to the contrib\winnt subdirectory of the tiff sources, - cd to that directory and build libtiff with 'nmake -f tiff.mak'. Note: - tiff.mak has only been verified to work under WinNT, not Win95 or 98. - However, the lastest distribution of libtiff includes a - contrib\win95\makefile.w95; that might work. + at time of writing) from ftp://ftp.xemacs.org/pub/xemacs/aux/ and unpack + it somewhere. Copy nt\tiff.mak from the xemacs sources to the + contrib\winnt subdirectory of the tiff sources, cd to that directory and + build libtiff with 'nmake -f tiff.mak'. Note: tiff.mak has only been + verified to work under WinNT, not Win95 or 98. However, the lastest + distribution of libtiff includes a contrib\win95\makefile.w95; that might + work. 4. If you want JPEG support grab the latest version of jpegsrc (jpeg-6b at - time of writing) and read the README for details on how to build it. + time of writing) from ftp://ftp.xemacs.org/pub/xemacs/aux/ and read the + README for details on how to build it. -5. If you want X-Face support, grab compface distribution and unpack it - somewhere. Copy nt\compface.mak from xemacs sources to the compface - directory. cd to that directory and build libcompface with - 'nmake -f compface.mak'. +5. If you want X-Face support, grab the compface distribution from + ftp://ftp.xemacs.org/pub/xemacs/aux/ and unpack it somewhere. + Copy nt\compface.mak from xemacs sources to the compface directory. + cd to that directory and build libcompface with 'nmake -f compface.mak'. * Building ========== -1. cd to the nt subdirectory of the xemacs distribution and build xemacs: - `nmake install -f xemacs.mak`, but read on before hitting Enter. - -2. If you're building with XPM support, add this to the nmake command line: - HAVE_XPM=1 XPM_DIR="x:\location\of\your\xpm\sources" - and similarly for JPEG and TIFF support. - - If you're building with PNG support, add this to the nmake command line: - HAVE_PNG=1 PNG_DIR="x:\location\of\your\png\sources" - ZLIB_DIR="x:\location\of\your\zlib\sources" - - If you want to build with GIF support, add this to the nmake command line: - HAVE_GIF=1 - - If you're building with X-Face support, add this to the nmake command line: - HAVE_XFACE=1 COMPFACE_DIR="x:\location\of\your\compface\sources" - - If you're building for X, add this to the nmake command line: - HAVE_X=1 X11_DIR=x:\root\directory\of\your\X11\installation - -3. By default, XEmacs will expect to find its packages in the subdirectories - "site-packages", "mule-packages" and "xemacs-packages" under the package - prefix directory "c:\Program Files\XEmacs". If you want it to look for - these subdirectories elsewhere, add this to the nmake command line: - PACKAGE_PREFIX="x:\your\package\directory" - If you change your mind and want to alter the package prefix directory - after you've built XEmacs, delete the file nt\obj\emacs.obj and rebuild - with the new PACKAGE_PREFIX setting. - -4. By default, XEmacs will be installed in directories under the directory - "c:\Program Files\XEmacs\XEmacs-21.2". If you want to install it - elsewhere, add this to the nmake command line: - INSTALL_DIR="x:\your\installation\directory" - -5. XEmacs can build its info files more quickly if you have a copy of the - makeinfo program. If you have a copy, add this to the nmake command line: - MAKEINFO="x:\location\of\makeinfo.exe" - If you don't have a copy of makeinfo then you'll need to have installed - the XEmacs texinfo package. - -6. Now you can press Enter. nmake will build temacs, the DOC file, update - the elc's, dump xemacs and install the relevant files in the directories - under the installation directory. - - Unless you set INSTALL_DIR above, the file that you should run to start - XEmacs will be installed as - "c:\Program Files\XEmacs\XEmacs-21.2\i586-pc-win32\runxemacs.exe". - You may want to create a shortcut to that file from your Desktop or +1. cd to the nt subdirectory of the xemacs distribution and copy the file + config.inc.samp to config.inc. Make any necessary modifications. This + file controls the options that XEmacs is built with: + + -- If you're building with XPM support, modify the appropriate lines in + config.inc as follows: + + HAVE_XPM=1 + XPM_DIR="x:\location\of\your\xpm\sources" + + and similarly for JPEG and TIFF support. + + -- If you're building with PNG support, modify the appropriate lines in + config.inc as follows: + + HAVE_PNG=1 + PNG_DIR="x:\location\of\your\png\sources" + ZLIB_DIR="x:\location\of\your\zlib\sources" + + -- If you're building with GIF support, modify the appropriate lines in + config.inc as follows: + + HAVE_GIF=1 + + -- If you're building with X-Face support, modify the appropriate lines in + config.inc as follows: + + HAVE_XFACE=1 + COMPFACE_DIR="x:\location\of\your\compface\sources" + + -- If you're building for X, modify the appropriate lines in config.inc + as follows: + + HAVE_X_WINDOWS=1 + X11_DIR=x:\root\directory\of\your\X11\installation + + -- By default, XEmacs will expect to find its packages in the + subdirectories "site-packages", "mule-packages" and "xemacs-packages" + under the directory "c:\Program Files\XEmacs". If you want it to look + for these subdirectories elsewhere, modify the appropriate lines in + config.inc as follows: + + PACKAGE_PREFIX="x:\your\package\directory" + + Make sure that the directory pointed to by PACKAGE_PREFIX contains + the xemacs-packages directory into which you installed the packages. + + -- XEmacs can build its info files more quickly if you have a copy of the + makeinfo program. If you have a copy, modify the appropriate lines in + config.inc as follows: + + MAKEINFO="x:\location\of\makeinfo.exe" + + If you don't have a copy of makeinfo then you'll need to have installed + the XEmacs texinfo package. + +2. If you want to install XEmacs when you build it, modify the appropriate + lines in config.inc as follows (you can also run XEmacs from its build + directory): + + INSTALL_DIR="x:\your\installation\directory" + + (By default, XEmacs will be installed in directories under the directory + "c:\Program Files\XEmacs\XEmacs-21.2".) + +2. If you want to build xemacs on the command line, use + `nmake install -f xemacs.mak', or just `nmake -f xemacs.mak' if you want + to run XEmacs from its build directory. nmake will build temacs, the DOC + file, update the elc's, dump xemacs and (optionally) install the relevant + files in the directories under the installation directory. + + If you chose to install XEmacs, the file that you should run to start + XEmacs will be installed (by default) as + "c:\Program Files\XEmacs\XEmacs-21.2\i586-pc-win32\xemacs.exe". + + To run from the build directory, run the file "nt\xemacs.exe" off of the + root of the build directory. + + You may want to create a shortcut to the file from your Desktop or Start Menu. +3. To build using MS Developer Studio, you can use the workspace file + `nt/xemacs.dsw'. This was prepared for Visual C++ 5.0; if you have + a different version and this file doesn't work, just open up + `nt/xemacs.mak' from within MS Developer Studio and it will offer to + wrap this Makefile in a workspace file, from which you can build. + Assuming you want to run from the build directory (which you will + want to do if you are planning on doing any development work on XEmacs), + use the following settings in Project/Settings...: + + Under the General tab: + + Build command line: NMAKE /f xemacs.mak + Output file name: ..\src\xemacs.exe + Browse info file name: ..\src\temacs.bsc + + Under the Debug tab: + + Executable for debug session: ..\src\xemacs.exe + + + If you want to install XEmacs when it's built, change the build command + line to "NMAKE install /f xemacs.mak". (You will have to make the same + change even if you use the provided workspace nt/xemacs.dsw.) + * Debugging under MS Developer Studio ===================================== The build process always creates debugging and "Source Browser" information -in the source tree for use with DevStudio. If you actually want to debug -XEmacs you should probably build a debug version of XEmacs: - -1. Delete the directory nt\obj and it's contents. +in the source tree for use with DevStudio. However that information is not +very useful unless you build a debug version of XEmacs: -2. Add DEBUG_XEMACS=1 to the nmake command line and rebuild. You probably - don't want to install your debug build so you should tell nmake to build - the 'all' target instead of the 'install' target. +1. Set DEBUG_XEMACS=1 and DEPEND=1 in config.inc and rebuild. -3. To make use of the debugging and "Source Browser" information, create a - new "console" project in DevStudio and, under Project/Settings, set: - Debug: executable name = full path of src\xemacs.exe - Link: output file name = full path of src\temacs.exe - Browse Info: browse info file name = full path of src\temacs.bsc - Remember to close the Source Browser file in DevStudio before rebuilding. +2. See instructions above for obtaining a workspace file for use with + MS Developer Studio. Build and debug your XEmacs this way. -4. Start XEmacs from within DevStudio or by running src\xemacs.exe so that - you get a console window which may contain helpful debugging info. +3. To display the contents of a lisp variable, type Shift-F9 (or use the + menu) to bring up the QuickWatch window, type debug_print(variable) and + click Recalculate. The output will appear in a console window, as well + as in the Debug window in MS Developer Studio. -5. To display the contents of a lisp variable click Debug/QuickWatch, type - debug_print(variable) and click Recalculate. The output will appear in - the console window. - -6. To view lisp variables in the "Watch" window wrap the variable in one of - the helper functions from the file src\console-msw.c. eg type - DSTRING(variable) in the "Watch" window to inspect a lisp string. +4. To view Lisp variables in the "Watch" window wrap the variable in one of + the helper functions from the file src\console-msw.c, for example type + DSTRING(variable) in the "Watch" window to inspect a Lisp string. * Known Problems ================ -Please look at the PROBLEMS file for known problems and at the TODO list for -the current list of problems and people working on them. - -Any other problems you need clarified, please email us and we will endeavour -to provide any assistance we can: +Please look at the PROBLEMS file for known problems. Any other problems you +need clarified, please email us and we will endeavour to provide any +assistance we can: The XEmacs NT Mailing List: xemacs-nt@xemacs.org Subscribe address: xemacs-nt-request@xemacs.org @@ -199,5 +259,6 @@ David Hobley Marc Paquette August Hill Jonathan Harris +Ben Wing and others. diff --git a/nt/config.h b/nt/config.h index a03e7c6..48528ef 100644 --- a/nt/config.h +++ b/nt/config.h @@ -21,7 +21,7 @@ Boston, MA 02111-1307, USA. */ /* Synched up with: FSF 19.30 (more or less). */ /* No code in XEmacs #includes config.h twice, but some of the code - intended to work with other packages as well (like gmalloc.c) + intended to work with other packages as well (like gmalloc.c) think they can include it as many times as they like. */ #ifndef _SRC_CONFIG_H_ #define _SRC_CONFIG_H_ @@ -286,7 +286,7 @@ Boston, MA 02111-1307, USA. */ /* Define HAVE_BERKELEY_DB if you want to use the BerkDB libraries */ #undef HAVE_BERKELEY_DB /* Full #include file path for Berkeley DB's db.h */ -#undef DB_H_PATH +#undef DB_H_FILE #if defined (HAVE_DBM) || defined (HAVE_BERKELEY_DB) # define HAVE_DATABASE @@ -295,8 +295,8 @@ Boston, MA 02111-1307, USA. */ /* Define HAVE_NCURSES if -lncurses is present. */ #undef HAVE_NCURSES /* Full #include file paths for ncurses' curses.h and term.h. */ -#undef CURSES_H_PATH -#undef TERM_H_PATH +#undef CURSES_H_FILE +#undef TERM_H_FILE #define LOWTAGS @@ -486,7 +486,7 @@ Boston, MA 02111-1307, USA. */ #undef SUNPRO /* Sun SparcStations, SGI machines, and HP9000s700s have support for playing - different sound files as beeps. If you are on a SparcStation but do not + different sound files as beeps. If you are on a SparcStation but do not have the sound option installed for some reason, then undefine HAVE_NATIVE_SOUND. (It's usually found in /usr/demo/SOUND/ on SunOS 4 and Solaris systems; on Solaris, you may need to install the "SUNWaudmo" @@ -536,7 +536,7 @@ Boston, MA 02111-1307, USA. */ uses, mbstowcs() and wcstombs(), are unusable when programs are statically linked (as XEmacs must be) because the static version of libc.a contains the *dynamic* versions of these functions. These - functions don't seem to be called when XEmacs is running, so it's + functions don't seem to be called when XEmacs is running, so it's enough to define stubs for them. This appears to be fixed in SunOS 4.1.2. diff --git a/nt/xemacs.mak b/nt/xemacs.mak index ed5ec7b..ca54812 100644 --- a/nt/xemacs.mak +++ b/nt/xemacs.mak @@ -24,6 +24,8 @@ # Synched up with: Not in FSF. # +default: all + XEMACS=.. LISP=$(XEMACS)\lisp LIB_SRC=$(XEMACS)\lib-src @@ -31,6 +33,7 @@ MODULES=$(XEMACS)\modules NT=$(XEMACS)\nt OUTDIR=$(NT)\obj SRC=$(XEMACS)\src +LWLIB_SRCDIR=$(XEMACS)\lwlib MAKEDIRSTRING=$(MAKEDIR:\=\\) XEMACSDIRSTRING=$(MAKEDIRSTRING:\\nt=) @@ -40,7 +43,7 @@ DEL=-del # Program name and version -!include "..\version.sh" +!include "$(XEMACS)\version.sh" !include "config.inc" @@ -53,6 +56,8 @@ INFODOCK_VERSION_STRING=$(infodock_major_version).$(infodock_minor_version).$(in PROGRAM_DEFINES=-DINFODOCK \ -DPATH_VERSION=\"$(INFODOCK_VERSION_STRING)\" \ -DPATH_PROGNAME=\"infodock\" \ + -DEMACS_PROGNAME=\"infodock\" \ + -DEMACS_VERSION=\"$(INFODOCK_VERSION_STRING)\" \ -DINFODOCK_MAJOR_VERSION=$(infodock_major_version) \ -DINFODOCK_MINOR_VERSION=$(infodock_minor_version) \ -DINFODOCK_BUILD_VERSION=$(infodock_build_version) @@ -64,7 +69,9 @@ XEMACS_VERSION_STRING=$(emacs_major_version).$(emacs_minor_version) !endif PROGRAM_DEFINES= \ -DPATH_VERSION=\"$(XEMACS_VERSION_STRING)\" \ - -DPATH_PROGNAME=\"xemacs\" + -DPATH_PROGNAME=\"xemacs\" \ + -DEMACS_VERSION=\"$(XEMACS_VERSION_STRING)\" \ + -DEMACS_PROGNAME=\"xemacs\" !endif # @@ -91,11 +98,11 @@ PACKAGE_PATH=~\.xemacs;;$(PACKAGE_PREFIX)\site-packages;$(PACKAGE_PREFIX)\xemacs ! endif !endif PATH_PACKAGEPATH="$(PACKAGE_PATH:\=\\)" -!if !defined(HAVE_MSW) -HAVE_MSW=1 +!if !defined(HAVE_MS_WINDOWS) +HAVE_MS_WINDOWS=1 !endif -!if !defined(HAVE_X) -HAVE_X=0 +!if !defined(HAVE_X_WINDOWS) +HAVE_X_WINDOWS=0 !endif !if !defined(HAVE_XPM) HAVE_XPM=0 @@ -133,6 +140,9 @@ HAVE_WIDGETS=1 !if !defined(DEBUG_XEMACS) DEBUG_XEMACS=0 !endif +!if !defined(QUICK_BUILD) +QUICK_BUILD=0 +!endif !if !defined(USE_UNION_TYPE) USE_UNION_TYPE=0 !endif @@ -201,67 +211,67 @@ CONFIG_ERROR=1 !message [[[Developer note: If you want to fix it, read Q112297 first]]] #### CONFIG_ERROR=1 !endif -!if !$(HAVE_MSW) && !$(HAVE_X) -!message Please specify at least one HAVE_MSW=1 and/or HAVE_X=1 +!if !$(HAVE_MS_WINDOWS) && !$(HAVE_X_WINDOWS) +!message Please specify at least one HAVE_MS_WINDOWS=1 and/or HAVE_X_WINDOWS=1 CONFIG_ERROR=1 !endif -!if $(HAVE_X) && !defined(X11_DIR) +!if $(HAVE_X_WINDOWS) && !defined(X11_DIR) !message Please specify root directory for your X11 installation: X11_DIR=path CONFIG_ERROR=1 !endif -!if $(HAVE_X) && defined(X11_DIR) && !exist("$(X11_DIR)\LIB\X11.LIB") +!if $(HAVE_X_WINDOWS) && defined(X11_DIR) && !exist("$(X11_DIR)\LIB\X11.LIB") !message Specified X11 directory does not contain "$(X11_DIR)\LIB\X11.LIB" CONFIG_ERROR=1 !endif -!if $(HAVE_MSW) && $(HAVE_XPM) && !defined(XPM_DIR) +!if $(HAVE_MS_WINDOWS) && $(HAVE_XPM) && !defined(XPM_DIR) !message Please specify root directory for your XPM installation: XPM_DIR=path CONFIG_ERROR=1 !endif -!if $(HAVE_MSW) && $(HAVE_XPM) && defined(XPM_DIR) && !exist("$(XPM_DIR)\lib\Xpm.lib") +!if $(HAVE_MS_WINDOWS) && $(HAVE_XPM) && defined(XPM_DIR) && !exist("$(XPM_DIR)\lib\Xpm.lib") !message Specified XPM directory does not contain "$(XPM_DIR)\lib\Xpm.lib" CONFIG_ERROR=1 !endif -!if $(HAVE_MSW) && $(HAVE_PNG) && !defined(PNG_DIR) +!if $(HAVE_MS_WINDOWS) && $(HAVE_PNG) && !defined(PNG_DIR) !message Please specify root directory for your PNG installation: PNG_DIR=path CONFIG_ERROR=1 !endif -!if $(HAVE_MSW) && $(HAVE_PNG) && defined(PNG_DIR) && !exist("$(PNG_DIR)\libpng.lib") +!if $(HAVE_MS_WINDOWS) && $(HAVE_PNG) && defined(PNG_DIR) && !exist("$(PNG_DIR)\libpng.lib") !message Specified PNG directory does not contain "$(PNG_DIR)\libpng.lib" CONFIG_ERROR=1 !endif -!if $(HAVE_MSW) && $(HAVE_PNG) && !defined(ZLIB_DIR) +!if $(HAVE_MS_WINDOWS) && $(HAVE_PNG) && !defined(ZLIB_DIR) !message Please specify root directory for your ZLIB installation: ZLIB_DIR=path CONFIG_ERROR=1 !endif -!if $(HAVE_MSW) && $(HAVE_PNG) && defined(ZLIB_DIR) && !exist("$(ZLIB_DIR)\zlib.lib") +!if $(HAVE_MS_WINDOWS) && $(HAVE_PNG) && defined(ZLIB_DIR) && !exist("$(ZLIB_DIR)\zlib.lib") !message Specified ZLIB directory does not contain "$(ZLIB_DIR)\zlib.lib" CONFIG_ERROR=1 !endif -!if $(HAVE_MSW) && $(HAVE_TIFF) && !defined(TIFF_DIR) +!if $(HAVE_MS_WINDOWS) && $(HAVE_TIFF) && !defined(TIFF_DIR) !message Please specify root directory for your TIFF installation: TIFF_DIR=path CONFIG_ERROR=1 !endif -!if $(HAVE_MSW) && $(HAVE_TIFF) && !exist("$(TIFF_DIR)\libtiff\libtiff.lib") +!if $(HAVE_MS_WINDOWS) && $(HAVE_TIFF) && !exist("$(TIFF_DIR)\libtiff\libtiff.lib") !message Specified TIFF directory does not contain "$(TIFF_DIR)\libtiff\libtiff.lib" CONFIG_ERROR=1 !endif -!if $(HAVE_MSW) && $(HAVE_JPEG) && !defined(JPEG_DIR) +!if $(HAVE_MS_WINDOWS) && $(HAVE_JPEG) && !defined(JPEG_DIR) !message Please specify root directory for your JPEG installation: JPEG_DIR=path CONFIG_ERROR=1 !endif -!if $(HAVE_MSW) && $(HAVE_JPEG) && !exist("$(JPEG_DIR)\libjpeg.lib") +!if $(HAVE_MS_WINDOWS) && $(HAVE_JPEG) && !exist("$(JPEG_DIR)\libjpeg.lib") !message Specified JPEG directory does not contain "$(JPEG_DIR)\libjpeg.lib" CONFIG_ERROR=1 !endif -!if $(HAVE_MSW) && $(HAVE_XFACE) && !defined(COMPFACE_DIR) +!if $(HAVE_MS_WINDOWS) && $(HAVE_XFACE) && !defined(COMPFACE_DIR) !message Please specify root directory for your COMPFACE installation: COMPFACE_DIR=path CONFIG_ERROR=1 !endif -!if $(HAVE_MSW) && $(HAVE_XFACE) && !exist("$(COMPFACE_DIR)\libcompface.lib") +!if $(HAVE_MS_WINDOWS) && $(HAVE_XFACE) && !exist("$(COMPFACE_DIR)\libcompface.lib") !message Specified COMPFACE directory does not contain "$(COMPFACE_DIR)\libcompface.lib" CONFIG_ERROR=1 !endif -!if $(HAVE_MSW) && $(HAVE_TOOLBARS) && !$(HAVE_XPM) +!if $(HAVE_MS_WINDOWS) && $(HAVE_TOOLBARS) && !$(HAVE_XPM) !message Toolbars require XPM support CONFIG_ERROR=1 !endif @@ -278,6 +288,27 @@ USE_INDEXED_LRECORD_IMPLEMENTATION=$(GUNG_HO) !endif # +# Whether to use dependency information generated by make-src-depend +# +!if !defined(DEPEND) +DEPEND=0 +!endif +!if $(DEPEND) +! if [if not exist $(OUTDIR)\nul mkdir "$(OUTDIR)"] +! endif +# generate an nmake-readable version of depend +! if [perl -p -e "s/^\x23ifdef (.+)/!if defined($$1)/; s/^\x23e/!e/;" \ + -e "s/([\s=^])([\w\d\.\-^]+\.[ch^])/$$1$(SRC:\=\\)\\$$2/g;" \ + -e "s/^(.+)\.o:(.+)/$(OUTDIR:\=\\)\\$$1.obj:$$2 $(NT:\=\\)\\config.inc/;" \ + < $(SRC)\depend > $(OUTDIR)\depend.tmp] +! endif +! include "$(OUTDIR)\depend.tmp" +!else +! if [echo WARNING: Compiling without dependency information.] +! endif +!endif + +# # Compiler command echo control. Define VERBOSECC=1 to get verbose compilation. # !if !defined(VERBOSECC) @@ -310,13 +341,13 @@ LIBC_LIB=libc.lib CFLAGS=-nologo -W3 $(OPT) $(C_LIBFLAG) -!if $(HAVE_X) +!if $(HAVE_X_WINDOWS) X_DEFINES=-DHAVE_X_WINDOWS X_INCLUDES=-I$(X11_DIR)\include X_LIBS=-libpath:$(X11_DIR)\lib Xaw.lib Xmu.lib Xt.lib SM.lib ICE.lib Xext.lib X11.lib !endif -!if $(HAVE_MSW) +!if $(HAVE_MS_WINDOWS) MSW_DEFINES=-DHAVE_MS_WINDOWS -DHAVE_SCROLLBARS -DHAVE_MENUBARS MSW_INCLUDES= MSW_LIBS= @@ -383,6 +414,10 @@ DEBUG_DEFINES=-DDEBUG_XEMACS -D_DEBUG DEBUG_FLAGS=-debug:full !endif +!if $(QUICK_BUILD) +QUICK_DEFINES=-DQUICK_BUILD +!endif + !if $(USE_MINIMAL_TAGBITS) TAGBITS_DEFINES=-DUSE_MINIMAL_TAGBITS !endif @@ -415,18 +450,16 @@ PATH_DEFINES=-DPATH_PREFIX=\"$(PATH_PREFIX)\" # Generic variables -INCLUDES=$(X_INCLUDES) $(MSW_INCLUDES) -I$(NT)\inc -I$(SRC) -I$(XEMACS)\lwlib +INCLUDES=$(X_INCLUDES) $(MSW_INCLUDES) -I$(NT)\inc -I$(SRC) -I$(LWLIB_SRCDIR) DEFINES=$(X_DEFINES) $(MSW_DEFINES) $(MULE_DEFINES) \ $(TAGBITS_DEFINES) $(LRECORD_DEFINES) $(UNION_DEFINES) \ - $(DUMPER_DEFINES) $(MALLOC_DEFINES) \ + $(DUMPER_DEFINES) $(MALLOC_DEFINES) $(QUICK_DEFINES) \ -DWIN32 -D_WIN32 -DWIN32_LEAN_AND_MEAN -DWINDOWSNT -Demacs \ -DHAVE_CONFIG_H $(PROGRAM_DEFINES) $(PATH_DEFINES) #------------------------------------------------------------------------------ -default: $(OUTDIR)\nul all - $(OUTDIR)\nul: -@mkdir $(OUTDIR) @@ -491,13 +524,14 @@ $(LIB_SRC)/minitar.exe : $(NT)/minitar.mak $(NT)/minitar.c nmake -nologo -f minitar.mak ZLIB="$(ZLIB_DIR)" NT="$(NT)" LIB_SRC="$(LIB_SRC)" LIB_SRC_TOOLS = \ - $(LIB_SRC)/make-docfile.exe \ + $(LIB_SRC)/etags.exe \ $(LIB_SRC)/hexl.exe \ - $(LIB_SRC)/movemail.exe \ + $(LIB_SRC)/i.exe \ + $(LIB_SRC)/make-docfile.exe \ $(LIB_SRC)/mmencode.exe \ + $(LIB_SRC)/movemail.exe \ $(LIB_SRC)/sorted-doc.exe \ - $(LIB_SRC)/wakeup.exe \ - $(LIB_SRC)/etags.exe + $(LIB_SRC)/wakeup.exe !if $(USE_MINITAR) LIB_SRC_TOOLS = \ $(LIB_SRC_TOOLS) \ @@ -506,6 +540,7 @@ LIB_SRC_TOOLS = \ !if $(USE_PORTABLE_DUMPER) LIB_SRC_TOOLS = \ $(XEMACS_INCLUDES) \ + $(LIB_SRC)/make-dump-id.exe \ $(LIB_SRC_TOOLS) !endif @@ -526,6 +561,15 @@ $(LIB_SRC)\run.res: $(LIB_SRC)\run.rc #------------------------------------------------------------------------------ +# dump-id.c file that contains the dump id + +$(SRC)\dump-id.c : $(LIB_SRC)/make-dump-id.exe + cd $(SRC) + $(LIB_SRC)\make-dump-id.exe + cd $(NT) + +#------------------------------------------------------------------------------ + # LASTFILE Library !if !$(USE_SYSTEM_MALLOC) || !$(USE_PORTABLE_DUMPER) @@ -546,12 +590,11 @@ $(OUTDIR)\lastfile.obj: $(LASTFILE_SRC)\lastfile.c #------------------------------------------------------------------------------ -!if $(HAVE_X) +!if $(HAVE_X_WINDOWS) # LWLIB Library LWLIB=$(OUTDIR)\lwlib.lib -LWLIB_SRC=$(XEMACS)\lwlib LWLIB_FLAGS=$(CFLAGS) $(INCLUDES) $(DEFINES) \ -DNEED_ATHENA -DNEED_LUCID \ -D_WINDOWS -DMENUBARS_LUCID -DSCROLLBARS_LUCID -DDIALOGS_ATHENA \ @@ -568,25 +611,25 @@ LWLIB_OBJS= \ $(LWLIB): $(LWLIB_OBJS) link.exe -lib -nologo -out:$@ $(LWLIB_OBJS) -$(OUTDIR)\lwlib-config.obj: $(LWLIB_SRC)\lwlib-config.c +$(OUTDIR)\lwlib-config.obj: $(LWLIB_SRCDIR)\lwlib-config.c $(CCV) $(LWLIB_FLAGS) $** -$(OUTDIR)\lwlib-utils.obj: $(LWLIB_SRC)\lwlib-utils.c +$(OUTDIR)\lwlib-utils.obj: $(LWLIB_SRCDIR)\lwlib-utils.c $(CCV) $(LWLIB_FLAGS) $** -$(OUTDIR)\lwlib-Xaw.obj: $(LWLIB_SRC)\lwlib-Xaw.c +$(OUTDIR)\lwlib-Xaw.obj: $(LWLIB_SRCDIR)\lwlib-Xaw.c $(CCV) $(LWLIB_FLAGS) $** -$(OUTDIR)\lwlib-Xlw.obj: $(LWLIB_SRC)\lwlib-Xlw.c +$(OUTDIR)\lwlib-Xlw.obj: $(LWLIB_SRCDIR)\lwlib-Xlw.c $(CCV) $(LWLIB_FLAGS) $** -$(OUTDIR)\lwlib.obj: $(LWLIB_SRC)\lwlib.c +$(OUTDIR)\lwlib.obj: $(LWLIB_SRCDIR)\lwlib.c $(CCV) $(LWLIB_FLAGS) $** -$(OUTDIR)\xlwmenu.obj: $(LWLIB_SRC)\xlwmenu.c +$(OUTDIR)\xlwmenu.obj: $(LWLIB_SRCDIR)\xlwmenu.c $(CCV) $(LWLIB_FLAGS) $** -$(OUTDIR)\xlwscrollbar.obj: $(LWLIB_SRC)\xlwscrollbar.c +$(OUTDIR)\xlwscrollbar.obj: $(LWLIB_SRCDIR)\xlwscrollbar.c $(CCV) $(LWLIB_FLAGS) $** !endif @@ -685,7 +728,7 @@ DOC_SRC5=\ $(SRC)\window.c \ $(SRC)\widget.c -!if $(HAVE_X) +!if $(HAVE_X_WINDOWS) DOC_SRC6=\ $(SRC)\balloon_help.c \ $(SRC)\console-x.c \ @@ -710,7 +753,7 @@ DOC_SRC6=\ $(SRC)\select-x.c !endif -!if $(HAVE_MSW) +!if $(HAVE_MS_WINDOWS) DOC_SRC7=\ $(SRC)\console-msw.c \ $(SRC)\device-msw.c \ @@ -734,7 +777,7 @@ DOC_SRC8=\ $(SRC)\mule.c \ $(SRC)\mule-charset.c \ $(SRC)\mule-ccl.c -! if $(HAVE_X) +! if $(HAVE_X_WINDOWS) DOC_SRC8=$(DOC_SRC8) $(SRC)\input-method-xlib.c ! endif !endif @@ -756,6 +799,9 @@ DOC_SRC10=\ !if !$(USE_PORTABLE_DUMPER) DOC_SRC11=\ $(SRC)\unexnt.c +!else +DOC_SRC11=\ + $(SRC)\dumper.c !endif #------------------------------------------------------------------------------ @@ -789,11 +835,11 @@ TEMACS_CPP_FLAGS=-c \ -DEMACS_MAJOR_VERSION=$(emacs_major_version) \ -DEMACS_MINOR_VERSION=$(emacs_minor_version) \ $(EMACS_BETA_VERSION) \ - -DXEMACS_CODENAME=\"$(xemacs_codename)\" \ + -DXEMACS_CODENAME=\"$(xemacs_codename:&=and)\" \ -DEMACS_CONFIGURATION=\"$(EMACS_CONFIGURATION)\" \ -DPATH_PACKAGEPATH=\"$(PATH_PACKAGEPATH)\" -!if $(HAVE_X) +!if $(HAVE_X_WINDOWS) TEMACS_X_OBJS=\ $(OUTDIR)\balloon-x.obj \ $(OUTDIR)\balloon_help.obj \ @@ -818,7 +864,7 @@ TEMACS_X_OBJS=\ $(OUTDIR)\select-x.obj !endif -!if $(HAVE_MSW) +!if $(HAVE_MS_WINDOWS) TEMACS_MSW_OBJS=\ $(OUTDIR)\console-msw.obj \ $(OUTDIR)\device-msw.obj \ @@ -842,7 +888,7 @@ TEMACS_MULE_OBJS=\ $(OUTDIR)\mule.obj \ $(OUTDIR)\mule-charset.obj \ $(OUTDIR)\mule-ccl.obj -! if $(HAVE_X) +! if $(HAVE_X_WINDOWS) TEMACS_MULE_OBJS=\ $(TEMACS_MULE_OBJS) $(OUTDIR)\input-method-xlib.obj ! endif @@ -865,6 +911,9 @@ TEMACS_ALLOC_OBJS=\ !if !$(USE_PORTABLE_DUMPER) TEMACS_DUMP_OBJS=\ $(OUTDIR)\unexnt.obj +!else +TEMACS_DUMP_OBJS=\ + $(OUTDIR)\dumper.obj !endif TEMACS_OBJS= \ @@ -975,6 +1024,8 @@ TEMACS_OBJS= \ $(CCV) $(TEMACS_CPP_FLAGS) $< -Fo$@ !endif +$(OUTDIR)\emacs.obj: $(XEMACS)\version.sh + $(OUTDIR)\TopLevelEmacsShell.obj: $(TEMACS_SRC)\EmacsShell-sub.c $(CCV) $(TEMACS_CPP_FLAGS) -DDEFINE_TOP_LEVEL_EMACS_SHELL $** -Fo$@ @@ -996,9 +1047,12 @@ $(TEMACS): $(TEMACS_INCLUDES) $(TEMACS_OBJS) $(OUTDIR)\xemacs.res @$(DEL) bscmake.tmp !endif !if $(USE_PORTABLE_DUMPER) - @if exist $(TEMACS_DIR)\xemacs.dmp del $(TEMACS_DIR)\xemacs.dmp + @if exist $(SRC)\dump-id.c del $(SRC)\dump-id.c +# make a new dump id file. There is probably a better way to do this, but this works + @if exist $(OUTDIR)\dump-id.obj del $(OUTDIR)\dump-id.obj + nmake -nologo -f xemacs.mak OUTDIR=$(OUTDIR) $(OUTDIR)\dump-id.obj link.exe @<< - $(TEMACS_LFLAGS) -out:$@ $(TEMACS_OBJS) $(TEMACS_LIBS) + $(TEMACS_LFLAGS) -out:$@ $(TEMACS_OBJS) $(TEMACS_LIBS) $(OUTDIR)\dump-id.obj << !else link.exe @<< @@ -1009,11 +1063,15 @@ $(TEMACS): $(TEMACS_INCLUDES) $(TEMACS_OBJS) $(OUTDIR)\xemacs.res $(OUTDIR)\xemacs.res: xemacs.rc rc -Fo$@ xemacs.rc -# Section handling automated tests starts here PROGNAME=$(SRC)\xemacs.exe +TEMACS_BATCH="$(LIB_SRC)\i" "$(TEMACS)" -batch +XEMACS_BATCH="$(LIB_SRC)\i" "$(PROGNAME)" -vanilla -batch + +# Section handling automated tests starts here + blddir=$(MAKEDIR:\=\\)\\.. -temacs_loadup=$(TEMACS) -batch -l $(LISP)/loadup.el +temacs_loadup=$(TEMACS_BATCH) -l $(LISP)/loadup.el dump_temacs = $(temacs_loadup) dump run_temacs = $(temacs_loadup) run-temacs ## We have automated tests!! @@ -1056,7 +1114,7 @@ tags: # Section handling info starts here !if !defined(MAKEINFO) -MAKEINFO=$(PROGNAME) -vanilla -batch -l texinfmt -f batch-texinfo-format +MAKEINFO=$(XEMACS_BATCH) -l texinfmt -f batch-texinfo-format !endif MANDIR = $(XEMACS)\man @@ -1237,7 +1295,7 @@ makeinfo-test: @<$(TEMACS_DIR)\NEEDTODUMP # This rule dumps xemacs and then possibly spawns sub-make if PURESPACE # requirements have changed. -dump-xemacs: temacs + +$(PROGNAME) : $(TEMACS) $(TEMACS_DIR)\NEEDTODUMP @echo >$(TEMACS_DIR)\SATISFIED cd $(TEMACS_DIR) set EMACSBOOTSTRAPLOADPATH=$(LISP);$(PACKAGE_PATH) set EMACSBOOTSTRAPMODULEPATH=$(MODULES) - -1 $(TEMACS) -batch -l $(TEMACS_DIR)\..\lisp\loadup.el dump + -1 $(TEMACS_BATCH) -l $(TEMACS_DIR)\..\lisp\loadup.el dump !if $(USE_PORTABLE_DUMPER) rc -d INCLUDE_DUMP -Fo $(OUTDIR)\xemacs.res $(NT)\xemacs.rc link.exe @<< - $(TEMACS_LFLAGS) -out:xemacs.exe $(TEMACS_OBJS) $(OUTDIR)\xemacs.res $(TEMACS_LIBS) + $(TEMACS_LFLAGS) -out:xemacs.exe $(TEMACS_OBJS) $(OUTDIR)\xemacs.res $(TEMACS_LIBS) $(OUTDIR)\dump-id.obj << # Make the resource section read/write since almost all of it is the dump # data which needs to be writable. This avoids having to copy it. @@ -1307,8 +1370,8 @@ dump-xemacs: temacs # use this rule to build the complete system all: installation $(OUTDIR)\nul $(LASTFILE) $(LWLIB) \ - $(LIB_SRC_TOOLS) $(RUNEMACS) $(TEMACS) update-elc $(DOC) dump-xemacs \ - $(LISP)/auto-autoloads.el $(LISP)/custom-load.el info + $(LIB_SRC_TOOLS) $(RUNEMACS) $(TEMACS) update-elc $(DOC) $(PROGNAME) \ + update-auto-and-custom info temacs: $(LASTFILE) $(TEMACS) @@ -1376,7 +1439,7 @@ distclean: $(DEL) *.info* depend: - cd $(SRCDIR) + cd $(SRC) perl ./make-src-depend > depend.tmp perl -MFile::Compare -e "compare('depend.tmp', 'depend') && rename('depend.tmp', 'depend') or unlink('depend.tmp')" @@ -1399,10 +1462,10 @@ XEmacs $(XEMACS_VERSION_STRING) $(xemacs_codename:"=\") configured for `$(EMACS_ !if $(INFODOCK) Building InfoDock. !endif -!if $(HAVE_MSW) +!if $(HAVE_MS_WINDOWS) Compiling in support for Microsoft Windows native GUI. !endif -!if $(HAVE_X) +!if $(HAVE_X_WINDOWS) Compiling in support for X-Windows. !endif !if $(HAVE_MULE) @@ -1482,6 +1545,9 @@ XEmacs $(XEMACS_VERSION_STRING) $(xemacs_codename:"=\") configured for `$(EMACS_ !if $(DEBUG_XEMACS) Compiling in extra debug checks. XEmacs will be slow! !endif +!if $(QUICK_BUILD) + Disabling non-essential build actions. Use with care! +!endif <menu_hash_table) #define FRAME_MSWINDOWS_TOOLBAR_HASH_TABLE(f) \ (FRAME_MSWINDOWS_DATA (f)->toolbar_hash_table) -#define FRAME_MSWINDOWS_WIDGET_HASH_TABLE(f) \ - (FRAME_MSWINDOWS_DATA (f)->widget_hash_table) +#define FRAME_MSWINDOWS_WIDGET_HASH_TABLE1(f) \ + (FRAME_MSWINDOWS_DATA (f)->widget_hash_table1) +#define FRAME_MSWINDOWS_WIDGET_HASH_TABLE2(f) \ + (FRAME_MSWINDOWS_DATA (f)->widget_hash_table2) +#define FRAME_MSWINDOWS_WIDGET_HASH_TABLE3(f) \ + (FRAME_MSWINDOWS_DATA (f)->widget_hash_table3) #define FRAME_MSWINDOWS_TOOLBAR_CHECKSUM(f,pos) \ (FRAME_MSWINDOWS_DATA (f)->toolbar_checksum[pos]) #define FRAME_MSWINDOWS_MENU_CHECKSUM(f) (FRAME_MSWINDOWS_DATA (f)->menu_checksum) @@ -297,6 +301,7 @@ HDDEDATA CALLBACK mswindows_dde_callback (UINT uType, UINT uFmt, HCONV hconv, 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); diff --git a/src/console-tty.c b/src/console-tty.c index 9ebfbf3..34bd768 100644 --- a/src/console-tty.c +++ b/src/console-tty.c @@ -118,11 +118,11 @@ tty_init_console (struct console *con, Lisp_Object props) #ifdef FILE_CODING tty_con->instream = make_decoding_input_stream (XLSTREAM (tty_con->instream), - Fget_coding_system (Vkeyboard_coding_system)); + Fget_coding_system (Qkeyboard)); Lstream_set_character_mode (XLSTREAM (tty_con->instream)); tty_con->outstream = make_encoding_output_stream (XLSTREAM (tty_con->outstream), - Fget_coding_system (Vterminal_coding_system)); + Fget_coding_system (Qterminal)); #endif /* FILE_CODING */ tty_con->terminal_type = terminal_type; tty_con->controlling_process = controlling_process; @@ -253,7 +253,7 @@ CODESYS defaults to the value of `keyboard-coding-system'. { set_decoding_stream_coding_system (XLSTREAM (CONSOLE_TTY_DATA (decode_tty_console (console))->instream), - Fget_coding_system (NILP (codesys) ? Vkeyboard_coding_system : codesys)); + Fget_coding_system (NILP (codesys) ? Qkeyboard : codesys)); return Qnil; } @@ -277,7 +277,7 @@ CODESYS defaults to the value of `terminal-coding-system'. { set_encoding_stream_coding_system (XLSTREAM (CONSOLE_TTY_DATA (decode_tty_console (console))->outstream), - Fget_coding_system (NILP (codesys) ? Vterminal_coding_system : codesys)); + Fget_coding_system (NILP (codesys) ? Qterminal : codesys)); /* Redraw tty */ face_property_was_changed (Vdefault_face, Qfont, Qtty); return Qnil; diff --git a/src/dialog-x.c b/src/dialog-x.c index bd57d0d..3d1acc3 100644 --- a/src/dialog-x.c +++ b/src/dialog-x.c @@ -51,10 +51,14 @@ maybe_run_dbox_text_callback (LWLIB_ID id) Lisp_Object text_field_callback; char *text_field_value = wv->value; VOID_TO_LISP (text_field_callback, wv->call_data); + text_field_callback = XCAR (XCDR (text_field_callback)); if (text_field_value) { - void *tmp = LISP_TO_VOID (list2 (text_field_callback, - build_string (text_field_value))); + void *tmp = + LISP_TO_VOID (cons3 (Qnil, + list2 (text_field_callback, + build_string (text_field_value)), + Qnil)); popup_selection_callback (0, id, (XtPointer) tmp); } } @@ -166,7 +170,8 @@ dbox_descriptor_to_widget_value (Lisp_Object desc) wv = xmalloc_widget_value (); gui_item = gui_parse_item_keywords (button); - if (!button_item_to_widget_value (gui_item, wv, allow_text_p, 1)) + if (!button_item_to_widget_value (Qdialog, + gui_item, wv, allow_text_p, 1, 0)) { free_widget_value_tree (wv); continue; diff --git a/src/eval.c b/src/eval.c index 4e9cbc4..803d96a 100644 --- a/src/eval.c +++ b/src/eval.c @@ -4641,13 +4641,13 @@ unbind_to_hairy (int count) { int quitf; + ++specpdl_ptr; + ++specpdl_depth_counter; + check_quit (); /* make Vquit_flag accurate */ quitf = !NILP (Vquit_flag); Vquit_flag = Qnil; - ++specpdl_ptr; - ++specpdl_depth_counter; - while (specpdl_depth_counter != count) { --specpdl_ptr; diff --git a/src/event-Xt.c b/src/event-Xt.c index f984949..154e5f0 100644 --- a/src/event-Xt.c +++ b/src/event-Xt.c @@ -67,7 +67,6 @@ Boston, MA 02111-1307, USA. */ #include "events-mod.h" -static void enqueue_Xt_dispatch_event (Lisp_Object event); static void handle_focus_event_1 (struct frame *f, int in_p); static struct event_stream *Xt_event_stream; @@ -1491,7 +1490,6 @@ handle_focus_event_1 (struct frame *f, int in_p) #ifdef HAVE_XIM XIM_focus_event (f, in_p); #endif /* HAVE_XIM */ - /* On focus change, clear all memory of sticky modifiers to avoid non-intuitive behavior. */ clear_sticky_modifiers (XDEVICE (FRAME_DEVICE (f))); @@ -1847,8 +1845,8 @@ emacs_Xt_handle_magic_event (Lisp_Event *emacs_event) break; case CreateNotify: - printf ("window created\n"); break; + default: break; } @@ -2513,7 +2511,7 @@ describe_event (XEvent *event) static Lisp_Object dispatch_event_queue, dispatch_event_queue_tail; -static void +void enqueue_Xt_dispatch_event (Lisp_Object event) { enqueue_event (event, &dispatch_event_queue, &dispatch_event_queue_tail); @@ -3079,6 +3077,42 @@ static void EmacsFreePixel ( /************************************************************************/ +/* handle focus changes for native widgets */ +/************************************************************************/ +static void +emacs_Xt_event_widget_focus_in (Widget w, + XEvent *event, + String *params, + Cardinal *num_params) +{ + struct frame* f = + x_any_widget_or_parent_to_frame (get_device_from_display (event->xany.display), w); + + XtSetKeyboardFocus (FRAME_X_SHELL_WIDGET (f), w); +} + +static void +emacs_Xt_event_widget_focus_out (Widget w, + XEvent *event, + String *params, + Cardinal *num_params) +{ +} + +static XtActionsRec widgetActionsList[] = +{ + {"widget-focus-in", emacs_Xt_event_widget_focus_in }, + {"widget-focus-out", emacs_Xt_event_widget_focus_out }, +}; + +static void +emacs_Xt_event_add_widget_actions (XtAppContext ctx) +{ + XtAppAddActions (ctx, widgetActionsList, 2); +} + + +/************************************************************************/ /* initialization */ /************************************************************************/ @@ -3214,6 +3248,8 @@ init_event_Xt_late (void) /* called when already initialized */ NULL, 0, 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); /* insert the visual inheritance patch/hack described above */ orig_shell_init_proc = shellClassRec.core_class.initialize; diff --git a/src/event-msw.c b/src/event-msw.c index 681743e..a949be8 100644 --- a/src/event-msw.c +++ b/src/event-msw.c @@ -870,7 +870,7 @@ mswindows_user_event_p (Lisp_Event* sevt) /* * Add an emacs event to the proper dispatch queue */ -static void +void mswindows_enqueue_dispatch_event (Lisp_Object event) { int user_p = mswindows_user_event_p (XEVENT(event)); @@ -1472,9 +1472,21 @@ mswindows_need_event (int badly_p) mswindows_waitable_handles [ix] = mswindows_waitable_handles [--mswindows_waitable_count]; kick_status_notify (); - /* Have to return something: there may be no accompanying - process event */ - mswindows_enqueue_magic_event (NULL, XM_BUMPQUEUE); + /* We need to return a process event here so that + (1) accept-process-output will return when called on this + process, and (2) status notifications will happen in + accept-process-output, sleep-for, and sit-for. */ + /* #### horrible kludge till my real process fixes go in. + */ + if (!NILP (Vprocess_list)) + { + Lisp_Object vaffanculo = XCAR (Vprocess_list); + mswindows_enqueue_process_event (XPROCESS (vaffanculo)); + } + else /* trash me soon. */ + /* Have to return something: there may be no accompanying + process event */ + mswindows_enqueue_magic_event (NULL, XM_BUMPQUEUE); } } #endif diff --git a/src/event-stream.c b/src/event-stream.c index 4b67a2e..e2b46bb 100644 --- a/src/event-stream.c +++ b/src/event-stream.c @@ -4117,10 +4117,10 @@ Magic events are handled as necessary. be done without an undo boundary. This counter is reset as soon as a command other than self-insert-command is executed. - Programmers can also use the `self-insert-undo-magic' + Programmers can also use the `self-insert-defer-undo' property to install that behaviour on functions other than `self-insert-command', or to change the magic - number 20 to something else. */ + number 20 to something else. #### DOCUMENT THIS! */ if (SYMBOLP (leaf)) { diff --git a/src/extents.c b/src/extents.c index 6900786..5fd8ad5 100644 --- a/src/extents.c +++ b/src/extents.c @@ -465,6 +465,10 @@ Lisp_Object Vdefault_text_properties; EXFUN (Fextent_properties, 1); EXFUN (Fset_extent_property, 3); +/* if true, we don't want to set any redisplay flags on modeline extent + changes */ +int in_modeline_generation; + /************************************************************************/ /* Generalized gap array */ @@ -1612,7 +1616,8 @@ extent_changed_for_redisplay (EXTENT extent, int descendants_too, when we need it. (b) we don't have to update the gutters when only extents attached to buffers have changed. */ - MARK_EXTENTS_CHANGED; + if (!in_modeline_generation) + MARK_EXTENTS_CHANGED; gutter_extent_signal_changed_region_maybe (object, extent_endpoint_bufpos (extent, 0), extent_endpoint_bufpos (extent, 1)); diff --git a/src/extents.h b/src/extents.h index 0f70381..d8afb56 100644 --- a/src/extents.h +++ b/src/extents.h @@ -318,6 +318,7 @@ EXFUN (Fset_extent_endpoints, 4); EXFUN (Fset_extent_parent, 2); extern int inside_undo; +extern int in_modeline_generation; struct extent_fragment *extent_fragment_new (Lisp_Object buffer_or_string, struct frame *frm); diff --git a/src/filelock.c b/src/filelock.c index b31766d..44df999 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -34,14 +34,14 @@ Lisp_Object Qask_user_about_supersession_threat; Lisp_Object Qask_user_about_lock; #ifdef CLASH_DETECTION - + /* The strategy: to lock a file FN, create a symlink .#FN in FN's directory, with link data `user@host.pid'. This avoids a single mount (== failure) point for lock files. When the host in the lock data is the current host, we can check if the pid is valid with kill. - + Otherwise, we could look at a separate file that maps hostnames to reboot times to see if the remote pid can possibly be valid, since we don't want Emacs to have to communicate via pipes or sockets or @@ -63,13 +63,16 @@ Lisp_Object Qask_user_about_lock; Similarly, we don't worry about a possible 14-character limit on file names, because those are all the same systems that don't have symlinks. - + This is compatible with the locking scheme used by Interleaf (which has contributed this implementation for Emacs), and was designed by Ethan Jacobson, Kimbo Mundy, and others. - + --karl@cs.umb.edu/karl@hq.ileaf.com. */ +/* Note that muleization is provided by using mule-encapsulated + versions of the system calls we use like symlink(), unlink(), etc... */ + /* Here is the structure that stores information about a lock. */ @@ -90,27 +93,27 @@ typedef struct /* Write the name of the lock file for FN into LFNAME. Length will be that of FN plus two more for the leading `.#' plus one for the null. */ #define MAKE_LOCK_NAME(lock, file) \ - (lock = (char *) alloca (XSTRING_LENGTH(file) + 2 + 1), \ - fill_in_lock_file_name (lock, (file))) + (lock = (char *) alloca (XSTRING_LENGTH (file) + 2 + 1), \ + fill_in_lock_file_name ((Bufbyte *) (lock), (file))) static void -fill_in_lock_file_name (lockfile, fn) - register char *lockfile; - register Lisp_Object fn; +fill_in_lock_file_name (Bufbyte *lockfile, Lisp_Object fn) { - register char *p; - - strcpy (lockfile, XSTRING_DATA(fn)); - - /* Shift the nondirectory part of the file name (including the null) - right two characters. Here is one of the places where we'd have to - do something to support 14-character-max file names. */ - for (p = lockfile + strlen (lockfile); p != lockfile && *p != '/'; p--) - p[2] = *p; - - /* Insert the `.#'. */ - p[1] = '.'; - p[2] = '#'; + Bufbyte *file_name = XSTRING_DATA (fn); + Bufbyte *p; + size_t dirlen; + + for (p = file_name + XSTRING_LENGTH (fn) - 1; + p > file_name && !IS_ANY_SEP (p[-1]); + p--) + ; + dirlen = p - file_name; + + memcpy (lockfile, file_name, dirlen); + p = lockfile + dirlen; + *(p++) = '.'; + *(p++) = '#'; + memcpy (p, file_name + dirlen, XSTRING_LENGTH (fn) - dirlen + 1); } /* Lock the lock file named LFNAME. @@ -118,21 +121,21 @@ fill_in_lock_file_name (lockfile, fn) Return 1 if successful, 0 if not. */ static int -lock_file_1 (char *lfname,int force) +lock_file_1 (char *lfname, int force) { - register int err; - char *user_name; - char *host_name; + int err; char *lock_info_str; + char *host_name; + char *user_name = user_login_name (NULL); - if (STRINGP (Fuser_login_name (Qnil))) - user_name = (char *) XSTRING_DATA (Fuser_login_name (Qnil)); - else + if (user_name == NULL) user_name = ""; - if (STRINGP (Fsystem_name ())) - host_name = (char *) XSTRING_DATA (Fsystem_name ()); + + if (STRINGP (Vsystem_name)) + host_name = (char *) XSTRING_DATA (Vsystem_name); else host_name = ""; + lock_info_str = (char *)alloca (strlen (user_name) + strlen (host_name) + LOCK_PID_MAX + 5); @@ -140,7 +143,7 @@ lock_file_1 (char *lfname,int force) (unsigned long) getpid ()); err = symlink (lock_info_str, lfname); - if (errno == EEXIST && force) + if (err != 0 && errno == EEXIST && force) { unlink (lfname); err = symlink (lock_info_str, lfname); @@ -157,7 +160,7 @@ lock_file_1 (char *lfname,int force) static int current_lock_owner (lock_info_type *owner, char *lfname) { - int o, p, len, ret; + int len, ret; int local_owner = 0; char *at, *dot; char *lfinfo = 0; @@ -171,7 +174,7 @@ current_lock_owner (lock_info_type *owner, char *lfname) len = readlink (lfname, lfinfo, bufsize); } while (len >= bufsize); - + /* If nonexistent lock file, all is well; otherwise, got strange error. */ if (len == -1) { @@ -181,7 +184,7 @@ current_lock_owner (lock_info_type *owner, char *lfname) /* Link info exists, so `len' is its length. Null terminate. */ lfinfo[len] = 0; - + /* Even if the caller doesn't want the owner info, we still have to read it to determine return value, so allocate it. */ if (!owner) @@ -189,7 +192,7 @@ current_lock_owner (lock_info_type *owner, char *lfname) owner = (lock_info_type *) alloca (sizeof (lock_info_type)); local_owner = 1; } - + /* Parse USER@HOST.PID. If can't parse, return -1. */ /* The USER is everything before the first @. */ at = strchr (lfinfo, '@'); @@ -202,7 +205,7 @@ current_lock_owner (lock_info_type *owner, char *lfname) owner->user = (char *) xmalloc (len + 1); strncpy (owner->user, lfinfo, len); owner->user[len] = 0; - + /* The PID is everything after the last `.'. */ owner->pid = atoi (dot + 1); @@ -214,10 +217,10 @@ current_lock_owner (lock_info_type *owner, char *lfname) /* We're done looking at the link info. */ xfree (lfinfo); - + /* On current host? */ - if (STRINGP (Fsystem_name ()) - && strcmp (owner->host, XSTRING_DATA(Fsystem_name ())) == 0) + if (STRINGP (Fsystem_name ()) + && strcmp (owner->host, (char *) XSTRING_DATA (Fsystem_name ())) == 0) { if (owner->pid == getpid ()) ret = 2; /* We own it. */ @@ -236,7 +239,7 @@ current_lock_owner (lock_info_type *owner, char *lfname) here's where we'd do it. */ ret = 1; } - + /* Avoid garbage. */ if (local_owner || ret <= 0) { @@ -260,7 +263,7 @@ lock_if_free (lock_info_type *clasher, char *lfname) if (errno != EEXIST) return -1; - + locker = current_lock_owner (clasher, lfname); if (locker == 2) { @@ -299,7 +302,7 @@ lock_file (Lisp_Object fn) /* dmoore - and can destroy current_buffer and all sorts of other mean nasty things with pointy teeth. If you call this make sure you protect things right. */ - /* Somebody updated the code in this function and removed the previous + /* Somebody updated the code in this function and removed the previous comment. -slb */ register Lisp_Object attack, orig_fn; @@ -323,7 +326,7 @@ lock_file (Lisp_Object fn) && NILP (Fverify_visited_file_modtime (subject_buf)) && !NILP (Ffile_exists_p (fn))) call1_in_buffer (XBUFFER(subject_buf), - Qask_user_about_supersession_threat, fn); + Qask_user_about_supersession_threat, fn); } /* Try to lock the lock. */ @@ -337,7 +340,7 @@ lock_file (Lisp_Object fn) sprintf (locker, "%s@%s (pid %lu)", lock_info.user, lock_info.host, lock_info.pid); FREE_LOCK_INFO (lock_info); - + attack = call2_in_buffer (BUFFERP (subject_buf) ? XBUFFER (subject_buf) : current_buffer, Qask_user_about_lock , fn, build_string (locker)); @@ -356,6 +359,9 @@ void unlock_file (Lisp_Object fn) { register char *lfname; + struct gcpro gcpro1; + + GCPRO1 (fn); fn = Fexpand_file_name (fn, Qnil); @@ -363,28 +369,29 @@ unlock_file (Lisp_Object fn) if (current_lock_owner (0, lfname) == 2) unlink (lfname); + + UNGCPRO; } void unlock_all_files (void) { register Lisp_Object tail; - register struct buffer *b; for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail)) { - b = XBUFFER (XCDR (XCAR (tail))); + struct buffer *b = XBUFFER (XCDR (XCAR (tail))); if (STRINGP (b->file_truename) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)) unlock_file (b->file_truename); } } DEFUN ("lock-buffer", Flock_buffer, 0, 1, 0, /* - Lock FILE, if current buffer is modified.\n\ -FILE defaults to current buffer's visited file,\n\ +Lock FILE, if current buffer is modified. +FILE defaults to current buffer's visited file, or else nothing is done if current buffer isn't visiting a file. */ - (file)) + (file)) { if (NILP (file)) file = current_buffer->file_truename; @@ -428,15 +435,18 @@ unlock_buffer (struct buffer *buffer) } DEFUN ("file-locked-p", Ffile_locked_p, 0, 1, 0, /* - Return nil if the FILENAME is not locked,\n\ +Return nil if the FILENAME is not locked, t if it is locked by you, else a string of the name of the locker. */ - (filename)) + (filename)) { Lisp_Object ret; register char *lfname; int owner; lock_info_type locker; + struct gcpro gcpro1; + + GCPRO1 (filename); filename = Fexpand_file_name (filename, Qnil); @@ -453,6 +463,8 @@ t if it is locked by you, else a string of the name of the locker. if (owner > 0) FREE_LOCK_INFO (locker); + UNGCPRO; + return ret; } diff --git a/src/frame-msw.c b/src/frame-msw.c index dce9917..f049a23 100644 --- a/src/frame-msw.c +++ b/src/frame-msw.c @@ -140,7 +140,11 @@ mswindows_init_frame_1 (struct frame *f, Lisp_Object props) make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); #endif /* hashtable of instantiated glyphs on the frame. */ - FRAME_MSWINDOWS_WIDGET_HASH_TABLE (f) = + FRAME_MSWINDOWS_WIDGET_HASH_TABLE1 (f) = + make_lisp_hash_table (50, HASH_TABLE_VALUE_WEAK, HASH_TABLE_EQUAL); + FRAME_MSWINDOWS_WIDGET_HASH_TABLE2 (f) = + make_lisp_hash_table (50, HASH_TABLE_VALUE_WEAK, HASH_TABLE_EQUAL); + FRAME_MSWINDOWS_WIDGET_HASH_TABLE3 (f) = make_lisp_hash_table (50, HASH_TABLE_VALUE_WEAK, HASH_TABLE_EQUAL); /* Will initialize these in WM_SIZE handler. We cannot do it now, because we do not know what is CW_USEDEFAULT height and width */ @@ -259,7 +263,9 @@ mswindows_mark_frame (struct frame *f) #ifdef HAVE_TOOLBARS mark_object (FRAME_MSWINDOWS_TOOLBAR_HASH_TABLE (f)); #endif - mark_object (FRAME_MSWINDOWS_WIDGET_HASH_TABLE (f)); + 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 diff --git a/src/frameslots.h b/src/frameslots.h index 1674ce6..4fe27bf 100644 --- a/src/frameslots.h +++ b/src/frameslots.h @@ -84,6 +84,9 @@ Boston, MA 02111-1307, USA. */ /* frame property list */ MARKED_SLOT (plist); + /* buffer_alist at last redisplay. */ + MARKED_SLOT (old_buffer_alist); + /* A copy of the global Vbuffer_list, to maintain a per-frame buffer ordering. The Vbuffer_list variable and the buffer_list slot of each frame contain exactly the same data, just in different orders. */ diff --git a/src/general.c b/src/general.c index 594d4fc..e3c8e4c 100644 --- a/src/general.c +++ b/src/general.c @@ -66,6 +66,7 @@ Lisp_Object Qdefault; Lisp_Object Qdelete; Lisp_Object Qdelq; Lisp_Object Qdevice; +Lisp_Object Qdialog; Lisp_Object Qdimension; Lisp_Object Qdisplay; Lisp_Object Qdoc_string; @@ -82,6 +83,7 @@ Lisp_Object Qfile_name; Lisp_Object Qfont; Lisp_Object Qframe; Lisp_Object Qfunction; +Lisp_Object Qfuncall; Lisp_Object Qgap_overhead; Lisp_Object Qgeneric; Lisp_Object Qgeometry; @@ -102,14 +104,17 @@ Lisp_Object Qkey_assoc; Lisp_Object Qkeyboard; Lisp_Object Qkeymap; Lisp_Object Qlandscape; +Lisp_Object Qlast_command; Lisp_Object Qleft; Lisp_Object Qleft_margin; +Lisp_Object Qlet; Lisp_Object Qlist; Lisp_Object Qmagic; Lisp_Object Qmalloc_overhead; Lisp_Object Qmarkers; Lisp_Object Qmax; Lisp_Object Qmemory; +Lisp_Object Qmenubar; Lisp_Object Qmessage; Lisp_Object Qminus; Lisp_Object Qmodifiers; @@ -160,6 +165,7 @@ Lisp_Object Qsyntax; Lisp_Object Qterminal; Lisp_Object Qtest; Lisp_Object Qtext; +Lisp_Object Qthis_command; Lisp_Object Qtimeout; Lisp_Object Qtimestamp; Lisp_Object Qtoolbar; @@ -218,6 +224,7 @@ syms_of_general (void) defsymbol (&Qdelete, "delete"); defsymbol (&Qdelq, "delq"); defsymbol (&Qdevice, "device"); + defsymbol (&Qdialog, "dialog"); defsymbol (&Qdimension, "dimension"); defsymbol (&Qdisplay, "display"); defsymbol (&Qdoc_string, "doc-string"); @@ -234,6 +241,7 @@ syms_of_general (void) defsymbol (&Qfont, "font"); defsymbol (&Qframe, "frame"); defsymbol (&Qfunction, "function"); + defsymbol (&Qfuncall, "funcall"); defsymbol (&Qgap_overhead, "gap-overhead"); defsymbol (&Qgeneric, "generic"); defsymbol (&Qgeometry, "geometry"); @@ -254,14 +262,17 @@ syms_of_general (void) defsymbol (&Qkeyboard, "keyboard"); defsymbol (&Qkeymap, "keymap"); defsymbol (&Qlandscape, "landscape"); + defsymbol (&Qlast_command, "last-command"); defsymbol (&Qleft, "left"); defsymbol (&Qleft_margin, "left-margin"); + defsymbol (&Qlet, "let"); defsymbol (&Qlist, "list"); defsymbol (&Qmagic, "magic"); defsymbol (&Qmalloc_overhead, "malloc-overhead"); defsymbol (&Qmarkers, "markers"); defsymbol (&Qmax, "max"); defsymbol (&Qmemory, "memory"); + defsymbol (&Qmenubar, "menubar"); defsymbol (&Qmessage, "message"); defsymbol (&Qminus, "-"); defsymbol (&Qmodifiers, "modifiers"); @@ -312,6 +323,7 @@ syms_of_general (void) defsymbol (&Qterminal, "terminal"); defsymbol (&Qtest, "test"); defsymbol (&Qtext, "text"); + defsymbol (&Qthis_command, "this-command"); defsymbol (&Qtimeout, "timeout"); defsymbol (&Qtimestamp, "timestamp"); defsymbol (&Qtoolbar, "toolbar"); diff --git a/src/glyphs-msw.c b/src/glyphs-msw.c index 4cd61ab..440e272 100644 --- a/src/glyphs-msw.c +++ b/src/glyphs-msw.c @@ -121,6 +121,42 @@ get_device_compdc (struct device *d) return DEVICE_MSPRINTER_HCDC (d); } +/* + * Initialize image instance pixel sizes in II. For a display bitmap, + * these will be same as real bitmap sizes. For a printer bitmap, + * these will be scaled up so that the bitmap is proportionally enlarged + * when output to printer. Redisplay code takes care of scaling, to + * conserve memory we do not really scale bitmaps. Set the watermark + * only here. + * #### Add support for unscalable bitmaps. + */ +static void init_image_instance_geometry (Lisp_Image_Instance *ii) +{ + Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii); + struct device *d = XDEVICE (device); + + if (/* #### Scaleable && */ DEVICE_MSPRINTER_P (d)) + { + HDC printer_dc = DEVICE_MSPRINTER_HCDC (d); + HDC display_dc = CreateCompatibleDC (NULL); + IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = + MulDiv (IMAGE_INSTANCE_MSWINDOWS_BITMAP_REAL_WIDTH (ii), + GetDeviceCaps (printer_dc, LOGPIXELSX), + GetDeviceCaps (display_dc, LOGPIXELSX)); + IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = + MulDiv (IMAGE_INSTANCE_MSWINDOWS_BITMAP_REAL_HEIGHT (ii), + GetDeviceCaps (printer_dc, LOGPIXELSY), + GetDeviceCaps (display_dc, LOGPIXELSY)); + } + else + { + IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = + IMAGE_INSTANCE_MSWINDOWS_BITMAP_REAL_WIDTH (ii); + IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = + IMAGE_INSTANCE_MSWINDOWS_BITMAP_REAL_HEIGHT (ii); + } +} + #define BPLINE(width) ((int)(~3UL & (unsigned long)((width) +3))) /************************************************************************/ @@ -350,11 +386,14 @@ init_image_instance_from_dibitmap (Lisp_Image_Instance *ii, IMAGE_INSTANCE_MSWINDOWS_BITMAP (ii) = bitmap; IMAGE_INSTANCE_MSWINDOWS_MASK (ii) = NULL; - IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = bmp_info->bmiHeader.biWidth; - IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = bmp_info->bmiHeader.biHeight; + IMAGE_INSTANCE_MSWINDOWS_BITMAP_REAL_WIDTH (ii) = + bmp_info->bmiHeader.biWidth; + IMAGE_INSTANCE_MSWINDOWS_BITMAP_REAL_HEIGHT (ii) = + bmp_info->bmiHeader.biHeight; IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = bmp_info->bmiHeader.biBitCount; XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii), x_hot); XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii), y_hot); + init_image_instance_geometry (ii); if (create_mask) { @@ -469,15 +508,15 @@ mswindows_initialize_image_instance_mask (Lisp_Image_Instance* image, BITMAPINFO *bmp_info = (BITMAPINFO*) xmalloc_and_zero (sizeof (BITMAPINFO) + sizeof (RGBQUAD)); int i, j; - int height = IMAGE_INSTANCE_PIXMAP_HEIGHT (image); + int height = IMAGE_INSTANCE_MSWINDOWS_BITMAP_REAL_HEIGHT (image); - int maskbpline = BPLINE ((IMAGE_INSTANCE_PIXMAP_WIDTH (image) + 7) / 8); - int bpline = BPLINE (IMAGE_INSTANCE_PIXMAP_WIDTH (image) * 3); + int maskbpline = BPLINE ((IMAGE_INSTANCE_MSWINDOWS_BITMAP_REAL_WIDTH (image) + 7) / 8); + int bpline = BPLINE (IMAGE_INSTANCE_MSWINDOWS_BITMAP_REAL_WIDTH (image) * 3); if (!bmp_info) return; - bmp_info->bmiHeader.biWidth=IMAGE_INSTANCE_PIXMAP_WIDTH (image); + bmp_info->bmiHeader.biWidth=IMAGE_INSTANCE_MSWINDOWS_BITMAP_REAL_WIDTH (image); bmp_info->bmiHeader.biHeight = height; bmp_info->bmiHeader.biPlanes = 1; bmp_info->bmiHeader.biSize=sizeof(BITMAPINFOHEADER); @@ -509,10 +548,10 @@ mswindows_initialize_image_instance_mask (Lisp_Image_Instance* image, /* build up an in-memory set of bits to mess with */ xzero (*bmp_info); - bmp_info->bmiHeader.biWidth=IMAGE_INSTANCE_PIXMAP_WIDTH (image); + bmp_info->bmiHeader.biWidth = IMAGE_INSTANCE_MSWINDOWS_BITMAP_REAL_WIDTH (image); bmp_info->bmiHeader.biHeight = -height; bmp_info->bmiHeader.biPlanes = 1; - bmp_info->bmiHeader.biSize=sizeof(BITMAPINFOHEADER); + bmp_info->bmiHeader.biSize = sizeof(BITMAPINFOHEADER); bmp_info->bmiHeader.biBitCount = 24; bmp_info->bmiHeader.biCompression = BI_RGB; bmp_info->bmiHeader.biClrUsed = 0; @@ -534,7 +573,7 @@ mswindows_initialize_image_instance_mask (Lisp_Image_Instance* image, /* now set the colored bits in the mask and transparent ones to black in the original */ - for (i=0; ifaces_changed + || + IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (p)) { /* set the widget font from the widget face */ SendMessage (WIDGET_INSTANCE_MSWINDOWS_HANDLE (p), @@ -2198,23 +2246,28 @@ mswindows_update_widget (Lisp_Image_Instance *p) callbacks. The hashtable is weak so deregistration is handled automatically */ static int -mswindows_register_gui_item (Lisp_Object gui, Lisp_Object domain) +mswindows_register_gui_item (Lisp_Object image_instance, + Lisp_Object gui, Lisp_Object domain) { Lisp_Object frame = FW_FRAME (domain); struct frame* f = XFRAME (frame); - int id = gui_item_id_hash (FRAME_MSWINDOWS_WIDGET_HASH_TABLE (f), + int id = gui_item_id_hash (FRAME_MSWINDOWS_WIDGET_HASH_TABLE2 (f), gui, WIDGET_GLYPH_SLOT); - Fputhash (make_int (id), - XGUI_ITEM (gui)->callback, - FRAME_MSWINDOWS_WIDGET_HASH_TABLE (f)); + Fputhash (make_int (id), image_instance, + FRAME_MSWINDOWS_WIDGET_HASH_TABLE1 (f)); + Fputhash (make_int (id), XGUI_ITEM (gui)->callback, + FRAME_MSWINDOWS_WIDGET_HASH_TABLE2 (f)); + Fputhash (make_int (id), XGUI_ITEM (gui)->callback_ex, + FRAME_MSWINDOWS_WIDGET_HASH_TABLE3 (f)); return id; } static int mswindows_register_widget_instance (Lisp_Object instance, Lisp_Object domain) { - return mswindows_register_gui_item (XIMAGE_INSTANCE_WIDGET_ITEM (instance), + return mswindows_register_gui_item (instance, + XIMAGE_INSTANCE_WIDGET_ITEM (instance), domain); } @@ -2361,7 +2414,7 @@ mswindows_widget_instantiate (Lisp_Object image_instance, Lisp_Object instantiat style = pgui->style; - if (!NILP (pgui->callback)) + if (!NILP (pgui->callback) || !NILP (pgui->callback_ex)) { id = mswindows_register_widget_instance (image_instance, domain); } @@ -2567,7 +2620,8 @@ static HTREEITEM add_tree_item (Lisp_Object image_instance, if (GUI_ITEMP (item)) { - tvitem.item.lParam = mswindows_register_gui_item (item, domain); + tvitem.item.lParam = mswindows_register_gui_item (image_instance, + item, domain); tvitem.item.mask |= TVIF_PARAM; TO_EXTERNAL_FORMAT (LISP_STRING, XGUI_ITEM (item)->name, C_STRING_ALLOCA, tvitem.item.pszText, @@ -2649,7 +2703,8 @@ static TC_ITEM* add_tab_item (Lisp_Object image_instance, if (GUI_ITEMP (item)) { - tvitem.lParam = mswindows_register_gui_item (item, domain); + tvitem.lParam = mswindows_register_gui_item (image_instance, + item, domain); tvitem.mask |= TCIF_PARAM; TO_EXTERNAL_FORMAT (LISP_STRING, XGUI_ITEM (item)->name, C_STRING_ALLOCA, tvitem.pszText, @@ -2726,13 +2781,8 @@ mswindows_tab_control_update (Lisp_Object image_instance) /* delete the pre-existing items */ SendMessage (wnd, TCM_DELETEALLITEMS, 0, 0); - /* Pick up the items we recorded earlier. We do this here so - that the callbacks get set up with the new items. */ - IMAGE_INSTANCE_WIDGET_ITEMS (ii) = - IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii); - IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii) = Qnil; /* add items to the tab */ - LIST_LOOP (rest, XCDR (IMAGE_INSTANCE_WIDGET_ITEMS (ii))) + LIST_LOOP (rest, XCDR (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii))) { add_tab_item (image_instance, wnd, XCAR (rest), IMAGE_INSTANCE_SUBWINDOW_FRAME (ii), i); @@ -2881,11 +2931,18 @@ mswindows_progress_gauge_update (Lisp_Object image_instance) { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - if (IMAGE_INSTANCE_WIDGET_PERCENT_CHANGED (ii)) + if (IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii)) { - /* #### I'm not convinced we should store this in the plist. */ - Lisp_Object val = Fplist_get (IMAGE_INSTANCE_WIDGET_PROPS (ii), - Q_percent, Qnil); + Lisp_Object val; +#ifdef ERROR_CHECK_GLYPHS + assert (GUI_ITEMP (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii))); +#endif + val = XGUI_ITEM (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii))->value; +#ifdef DEBUG_WIDGET_OUTPUT + printf ("progress gauge displayed value on %p updated to %ld\n", + WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii), + XINT(val)); +#endif CHECK_INT (val); SendMessage (WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii), PBM_SETPOS, (WPARAM)XINT (val), 0); diff --git a/src/glyphs-msw.h b/src/glyphs-msw.h index dbfd85e..80d7c64 100644 --- a/src/glyphs-msw.h +++ b/src/glyphs-msw.h @@ -36,6 +36,7 @@ struct mswindows_image_instance_data { HBITMAP* bitmaps; HICON icon; + int real_width, real_height; }; #define MSWINDOWS_IMAGE_INSTANCE_DATA(i) \ @@ -51,6 +52,10 @@ struct mswindows_image_instance_data (*(HBITMAP*)&(IMAGE_INSTANCE_PIXMAP_MASK (i))) /* Make it lvalue */ #define IMAGE_INSTANCE_MSWINDOWS_ICON(i) \ (MSWINDOWS_IMAGE_INSTANCE_DATA (i)->icon) +#define IMAGE_INSTANCE_MSWINDOWS_BITMAP_REAL_WIDTH(i) \ + (MSWINDOWS_IMAGE_INSTANCE_DATA (i)->real_width) +#define IMAGE_INSTANCE_MSWINDOWS_BITMAP_REAL_HEIGHT(i) \ + (MSWINDOWS_IMAGE_INSTANCE_DATA (i)->real_height) #define XIMAGE_INSTANCE_MSWINDOWS_BITMAP(i) \ IMAGE_INSTANCE_MSWINDOWS_BITMAP (XIMAGE_INSTANCE (i)) diff --git a/src/glyphs-widget.c b/src/glyphs-widget.c index 355be6e..8456c25 100644 --- a/src/glyphs-widget.c +++ b/src/glyphs-widget.c @@ -57,8 +57,10 @@ DEFINE_IMAGE_INSTANTIATOR_FORMAT (layout); Lisp_Object Qlayout; Lisp_Object Q_descriptor, Q_height, Q_width, Q_properties, Q_items; -Lisp_Object Q_image, Q_text, Q_percent, Q_orientation, Q_justify, Q_border; +Lisp_Object Q_image, Q_text, Q_orientation, Q_justify, Q_border; Lisp_Object Qetched_in, Qetched_out, Qbevel_in, Qbevel_out; +Lisp_Object Vwidget_callback_current_channel; +Lisp_Object Qwidget_callback_current_channel; #ifdef DEBUG_WIDGETS int debug_widget_instances; @@ -356,6 +358,14 @@ update_widget (Lisp_Object widget) IMAGE_INSTANCE_WIDGET_TYPE (ii), ERROR_ME_NOT); MAYBE_IIFORMAT_METH (meths, update, (widget)); + + /* Pick up the items we recorded earlier. */ + if (IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii)) + { + IMAGE_INSTANCE_WIDGET_ITEMS (ii) = + IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii); + IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii) = Qnil; + } } /* Query for a widgets desired geometry. If no type specific method is @@ -511,7 +521,7 @@ initialize_widget_image_instance (Lisp_Image_Instance *ii, Lisp_Object type) 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) = 0; + IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) = LAYOUT_HORIZONTAL; IMAGE_INSTANCE_SUBWINDOW_JUSTIFY (ii) = 0; } @@ -597,10 +607,10 @@ widget_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, /* make sure we are designated as the parent. */ XIMAGE_INSTANCE_PARENT (gii) = image_instance; children = Fcons (gii, children); - /* Make sure elements in the layout are in the order the - user expected. */ - children = Fnreverse (children); } + /* Make sure elements in the layout are in the order the + user expected. */ + children = Fnreverse (children); IMAGE_INSTANCE_LAYOUT_CHILDREN (ii) = children; } /* retrieve the gui item information. This is easy if we have been @@ -619,7 +629,7 @@ widget_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, /* 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) = 1; + IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) = LAYOUT_VERTICAL; /* parse more gui items out of the properties */ if (!NILP (props) @@ -659,7 +669,7 @@ widget_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, if (!NILP (pixheight)) { - if (!INTP (pixwidth)) + if (!INTP (pixheight)) IMAGE_INSTANCE_WIDGET_HEIGHT_SUBR (ii) = pixheight; else { @@ -716,6 +726,33 @@ widget_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, #endif } +/* Get the geometry of a button control. We need to adjust the size + depending on the type of button. */ +static void +button_query_geometry (Lisp_Object image_instance, + unsigned int* width, unsigned int* height, + enum image_instance_geometry disp, Lisp_Object domain) +{ + Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); + unsigned int w, h; + query_string_geometry (IMAGE_INSTANCE_WIDGET_TEXT (ii), + IMAGE_INSTANCE_WIDGET_FACE (ii), + &w, &h, 0, domain); + /* Adjust the size for borders. */ + if (IMAGE_INSTANCE_SUBWINDOW_H_RESIZEP (ii)) + { + *width = w + 2 * WIDGET_BORDER_WIDTH; + + if (EQ (XGUI_ITEM (IMAGE_INSTANCE_WIDGET_ITEM (ii))->style, Qradio) + || + EQ (XGUI_ITEM (IMAGE_INSTANCE_WIDGET_ITEM (ii))->style, Qtoggle)) + /* This is an approximation to the size of the actual button bit. */ + *width += 12; + } + if (IMAGE_INSTANCE_SUBWINDOW_V_RESIZEP (ii)) + *height = h + 2 * WIDGET_BORDER_HEIGHT; +} + /* tree-view geometry - get the height right */ static void tree_view_query_geometry (Lisp_Object image_instance, @@ -816,12 +853,21 @@ progress_gauge_set_property (Lisp_Object image_instance, { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - if (EQ (prop, Q_percent)) + if (EQ (prop, Q_value)) { CHECK_INT (val); - IMAGE_INSTANCE_WIDGET_PROPS (ii) - = Fplist_put (IMAGE_INSTANCE_WIDGET_PROPS (ii), prop, val); - IMAGE_INSTANCE_WIDGET_PERCENT_CHANGED (ii) = 1; +#ifdef DEBUG_WIDGET_OUTPUT + printf ("progress gauge value set to %ld\n", XINT (val)); +#endif + IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii) = + copy_gui_item_tree (IMAGE_INSTANCE_WIDGET_ITEMS (ii)); +#ifdef ERROR_CHECK_GLYPHS + assert (GUI_ITEMP (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii))); +#endif + if (GUI_ITEMP (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii))) + XGUI_ITEM (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii))->value = val; + + IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii) = 1; return Qt; } @@ -921,56 +967,76 @@ layout_query_geometry (Lisp_Object image_instance, unsigned int* width, Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object items = IMAGE_INSTANCE_LAYOUT_CHILDREN (ii), rest; int maxph = 0, maxpw = 0, nitems = 0, ph_adjust = 0; + unsigned int gheight, gwidth; + + /* First just set up what we already have. */ + if (width) *width = IMAGE_INSTANCE_WIDTH (ii); + if (height) *height = IMAGE_INSTANCE_HEIGHT (ii); + + /* If we are not allowed to dynamically size then return. */ + if (!IMAGE_INSTANCE_SUBWINDOW_V_RESIZEP (ii) + && + !IMAGE_INSTANCE_SUBWINDOW_H_RESIZEP (ii)) + return; + /* Pick up the border text if we have one. */ + if (INTP (IMAGE_INSTANCE_LAYOUT_BORDER (ii))) + { + image_instance_query_geometry (XCAR (items), &gwidth, &gheight, disp, domain); + ph_adjust = gheight / 2; + items = XCDR (items); + } + /* Flip through the items to work out how much stuff we have to display */ LIST_LOOP (rest, items) { Lisp_Object glyph = XCAR (rest); - unsigned int gheight, gwidth; - image_instance_query_geometry (glyph, &gwidth, &gheight, disp, domain); - /* Pick up the border text if we have one. */ - if (INTP (IMAGE_INSTANCE_LAYOUT_BORDER (ii)) - && NILP (XCDR (rest))) + nitems ++; + if (IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) + == LAYOUT_HORIZONTAL) { - ph_adjust = gheight / 2; + maxph = max (maxph, gheight); + maxpw += gwidth; } else { - - nitems ++; - if (IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) - == LAYOUT_HORIZONTAL) - { - maxph = max (maxph, gheight); - maxpw += gwidth; - } - else - { - maxpw = max (maxpw, gwidth); - maxph += gheight; - } + maxpw = max (maxpw, gwidth); + maxph += gheight; } } - /* work out spacing between items and bounds of the layout. No user - provided width so we just do default spacing. */ - if (IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) - == LAYOUT_HORIZONTAL) + /* Work out minimum space we need to fit all the items. This could + have been fixed by the user. */ + if (!NILP (IMAGE_INSTANCE_WIDGET_WIDTH_SUBR (ii))) + { + Lisp_Object dynamic_width = + Feval (IMAGE_INSTANCE_WIDGET_WIDTH_SUBR (ii)); + if (INTP (dynamic_width)) + *width = XINT (dynamic_width); + } + else if (IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) + == LAYOUT_HORIZONTAL) *width = maxpw + (nitems + 1) * WIDGET_BORDER_WIDTH * 2; else *width = maxpw + 2 * WIDGET_BORDER_WIDTH * 2; /* Work out vertical spacings. */ - if (IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) - == LAYOUT_VERTICAL) + if (!NILP (IMAGE_INSTANCE_WIDGET_HEIGHT_SUBR (ii))) + { + Lisp_Object dynamic_height = + Feval (IMAGE_INSTANCE_WIDGET_HEIGHT_SUBR (ii)); + if (INTP (dynamic_height)) + *height = XINT (dynamic_height); + } + else if (IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) + == LAYOUT_VERTICAL) *height = maxph + (nitems + 1) * WIDGET_BORDER_HEIGHT * 2 + ph_adjust; - else + else *height = maxph + 2 * WIDGET_BORDER_HEIGHT * 2 + ph_adjust; } - static void layout_layout (Lisp_Object image_instance, unsigned int width, unsigned int height, Lisp_Object domain) @@ -981,38 +1047,41 @@ layout_layout (Lisp_Object image_instance, int x, y, maxph = 0, maxpw = 0, nitems = 0, horiz_spacing, vert_spacing, ph_adjust = 0; unsigned int gheight, gwidth; + + /* Pick up the border text if we have one. */ + if (INTP (IMAGE_INSTANCE_LAYOUT_BORDER (ii))) + { + Lisp_Object border = XCAR (items); + items = XCDR (items); + image_instance_query_geometry (border, &gwidth, &gheight, + IMAGE_DESIRED_GEOMETRY, domain); + /* #### Really, what should this be? */ + XIMAGE_INSTANCE_XOFFSET (border) = 10; + XIMAGE_INSTANCE_YOFFSET (border) = 0; + ph_adjust = gheight / 2; + IMAGE_INSTANCE_LAYOUT_BORDER (ii) = make_int (ph_adjust); + + image_instance_layout (border, gwidth, gheight, domain); + } - /* flip through the items to work out how much stuff we have to display */ + /* Flip through the items to work out how much stuff we have to display. */ LIST_LOOP (rest, items) { Lisp_Object glyph = XCAR (rest); image_instance_query_geometry (glyph, &gwidth, &gheight, IMAGE_DESIRED_GEOMETRY, domain); - - /* Pick up the border text if we have one. */ - if (INTP (IMAGE_INSTANCE_LAYOUT_BORDER (ii)) - && NILP (XCDR (rest))) + nitems ++; + if (IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) + == LAYOUT_HORIZONTAL) { - XIMAGE_INSTANCE_XOFFSET (glyph) = 10; /* Really, what should this be? */ - XIMAGE_INSTANCE_YOFFSET (glyph) = 0; - ph_adjust = gheight / 2; - IMAGE_INSTANCE_LAYOUT_BORDER (ii) = make_int (ph_adjust); + maxph = max (maxph, gheight); + maxpw += gwidth; } else { - nitems ++; - if (IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) - == LAYOUT_HORIZONTAL) - { - maxph = max (maxph, gheight); - maxpw += gwidth; - } - else - { - maxpw = max (maxpw, gwidth); - maxph += gheight; - } + maxpw = max (maxpw, gwidth); + maxph += gheight; } } @@ -1051,42 +1120,38 @@ layout_layout (Lisp_Object image_instance, image_instance_query_geometry (glyph, &gwidth, &gheight, IMAGE_DESIRED_GEOMETRY, domain); - if (!INTP (IMAGE_INSTANCE_LAYOUT_BORDER (ii)) - || !NILP (XCDR (rest))) - { - if (IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) - == LAYOUT_HORIZONTAL) - { - if (IMAGE_INSTANCE_SUBWINDOW_JUSTIFY (ii) - == LAYOUT_JUSTIFY_RIGHT) - y = height - (gheight + vert_spacing); - if (IMAGE_INSTANCE_SUBWINDOW_JUSTIFY (ii) - == LAYOUT_JUSTIFY_CENTER) - y = (height - gheight) / 2; - } - else - { - if (IMAGE_INSTANCE_SUBWINDOW_JUSTIFY (ii) - == LAYOUT_JUSTIFY_RIGHT) - x = width - (gwidth + horiz_spacing); - if (IMAGE_INSTANCE_SUBWINDOW_JUSTIFY (ii) - == LAYOUT_JUSTIFY_CENTER) - x = (width - gwidth) / 2; - } + if (IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) + == LAYOUT_HORIZONTAL) + { + if (IMAGE_INSTANCE_SUBWINDOW_JUSTIFY (ii) + == LAYOUT_JUSTIFY_RIGHT) + y = height - (gheight + vert_spacing); + if (IMAGE_INSTANCE_SUBWINDOW_JUSTIFY (ii) + == LAYOUT_JUSTIFY_CENTER) + y = (height - gheight) / 2; + } + else + { + if (IMAGE_INSTANCE_SUBWINDOW_JUSTIFY (ii) + == LAYOUT_JUSTIFY_RIGHT) + x = width - (gwidth + horiz_spacing); + if (IMAGE_INSTANCE_SUBWINDOW_JUSTIFY (ii) + == LAYOUT_JUSTIFY_CENTER) + x = (width - gwidth) / 2; + } - XIMAGE_INSTANCE_XOFFSET (glyph) = x; - XIMAGE_INSTANCE_YOFFSET (glyph) = y; + XIMAGE_INSTANCE_XOFFSET (glyph) = x; + XIMAGE_INSTANCE_YOFFSET (glyph) = y; - if (IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) - == LAYOUT_HORIZONTAL) - { - x += (gwidth + horiz_spacing); - } - else - { - y += (gheight + vert_spacing); - } - } + if (IMAGE_INSTANCE_SUBWINDOW_ORIENT (ii) + == LAYOUT_HORIZONTAL) + { + x += (gwidth + horiz_spacing); + } + else + { + y += (gheight + vert_spacing); + } /* Now layout subwidgets if they require it. */ image_instance_layout (glyph, gwidth, gheight, domain); @@ -1107,7 +1172,6 @@ syms_of_glyphs_widget (void) defkeyword (&Q_properties, ":properties"); defkeyword (&Q_items, ":items"); defkeyword (&Q_image, ":image"); - defkeyword (&Q_percent, ":percent"); defkeyword (&Q_text, ":text"); defkeyword (&Q_orientation, ":orientation"); defkeyword (&Q_justify, ":justify"); @@ -1117,6 +1181,7 @@ syms_of_glyphs_widget (void) defsymbol (&Qetched_out, "etched-out"); defsymbol (&Qbevel_in, "bevel-in"); defsymbol (&Qbevel_out, "bevel-out"); + defsymbol (&Qwidget_callback_current_channel, "widget-callback-current-channel"); } #define VALID_GUI_KEYWORDS(type) do { \ @@ -1132,6 +1197,7 @@ syms_of_glyphs_widget (void) 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) @@ -1160,6 +1226,7 @@ static void image_instantiator_buttons (void) IIFORMAT_HAS_SHARED_METHOD (button, possible_dest_types, widget); IIFORMAT_HAS_SHARED_METHOD (button, instantiate, widget); IIFORMAT_HAS_SHARED_METHOD (button, normalize, widget); + IIFORMAT_HAS_METHOD (button, query_geometry); IIFORMAT_VALID_KEYWORD (button, Q_image, check_valid_glyph_or_instantiator); VALID_WIDGET_KEYWORDS (button); @@ -1257,8 +1324,7 @@ static void image_instantiator_layout (void) IIFORMAT_HAS_METHOD (layout, normalize); IIFORMAT_HAS_METHOD (layout, query_geometry); IIFORMAT_HAS_METHOD (layout, layout); - IIFORMAT_VALID_KEYWORD (layout, Q_pixel_width, check_valid_int_or_function); - IIFORMAT_VALID_KEYWORD (layout, Q_pixel_height, check_valid_int_or_function); + VALID_WIDGET_KEYWORDS (layout); IIFORMAT_VALID_KEYWORD (layout, Q_orientation, check_valid_orientation); IIFORMAT_VALID_KEYWORD (layout, Q_justify, check_valid_justification); IIFORMAT_VALID_KEYWORD (layout, Q_border, check_valid_border); @@ -1293,4 +1359,10 @@ void vars_of_glyphs_widget (void) { reinit_vars_of_glyphs_widget (); + + DEFVAR_LISP ("widget-callback-current-channel", &Vwidget_callback_current_channel /* +The domain that is current when a widget callback is invoked. +This is invariably the frame that the widget is instantiated in. +*/); + Vwidget_callback_current_channel = Qnil; } diff --git a/src/glyphs-x.c b/src/glyphs-x.c index 0651929..4ed6e97 100644 --- a/src/glyphs-x.c +++ b/src/glyphs-x.c @@ -264,7 +264,7 @@ convert_EImage_to_XImage (Lisp_Object device, int width, int height, gr = *ip++; bl = *ip++; conv.val = pixarray[QUANT_GET_COLOR(qtable,rd,gr,bl)]; -#if WORDS_BIGENDIAN +#ifdef WORDS_BIGENDIAN if (outimg->byte_order == MSBFirst) for (q = 4-byte_cnt; q < 4; q++) *dp++ = conv.cp[q]; else @@ -339,7 +339,7 @@ convert_EImage_to_XImage (Lisp_Object device, int width, int height, bl = *ip++ >> (8 - bbits); conv.val = (rd << rshift) | (gr << gshift) | (bl << bshift); -#if WORDS_BIGENDIAN +#ifdef WORDS_BIGENDIAN if (outimg->byte_order == MSBFirst) for (q = 4-byte_cnt; q < 4; q++) *dp++ = conv.cp[q]; else @@ -2189,14 +2189,11 @@ x_update_widget (Lisp_Image_Instance *p) need to update most other things after the items have changed.*/ if (IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (p)) { - /* Pick up the items we recorded earlier. We do this here so - that the callbacks get set up with the new items. */ - IMAGE_INSTANCE_WIDGET_ITEMS (p) = - IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (p); - IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (p) = Qnil; + Lisp_Object image_instance; + XSETIMAGE_INSTANCE (image_instance, p); wv = gui_items_to_widget_values - (IMAGE_INSTANCE_WIDGET_ITEMS (p)); + (image_instance, IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (p)); wv->change = STRUCTURAL_CHANGE; /* now modify the widget */ lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (p), @@ -2211,7 +2208,7 @@ x_update_widget (Lisp_Image_Instance *p) return; /* Possibly update the colors and font */ - if (IMAGE_INSTANCE_WIDGET_FACE_CHANGED (p) + if (IMAGE_INSTANCE_WIDGET_FACE_CHANGED (p) || XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (p))->faces_changed || @@ -2234,7 +2231,9 @@ x_update_widget (Lisp_Image_Instance *p) /* Possibly update the size. */ if (IMAGE_INSTANCE_SIZE_CHANGED (p) || - IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (p)) + IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (p) + || + IMAGE_INSTANCE_TEXT_CHANGED (p)) { assert (IMAGE_INSTANCE_X_WIDGET_ID (p) && IMAGE_INSTANCE_X_CLIPWIDGET (p)) ; @@ -2503,16 +2502,6 @@ x_widget_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, IMAGE_INSTANCE_SUBWINDOW_ID (ii) = (void*)wid; IMAGE_INSTANCE_X_WIDGET_LWID (ii) = id; -#if 0 - /* Resize the widget here so that the values do not get copied by - lwlib. */ - ac = 0; - XtSetArg (al [ac], XtNwidth, - (Dimension)IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii)); ac++; - XtSetArg (al [ac], XtNheight, - (Dimension)IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii)); ac++; - XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, ac); -#endif /* because the EmacsManager is the widgets parent we have to offset the redisplay of the widget by the amount the text widget is inside the manager. */ @@ -2554,9 +2543,7 @@ x_button_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, 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 = xmalloc_widget_value (); - - button_item_to_widget_value (gui, wv, 1, 1); + widget_value* wv = gui_items_to_widget_values (image_instance, gui); if (!NILP (glyph)) { @@ -2583,6 +2570,30 @@ x_button_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, } } +/* Update a button's clicked state. + + #### This is overkill, but it works. Right now this causes all + button instances to flash for some reason buried deep in lwlib. In + theory this should be the Right Thing to do since lwlib should only + merge in changed values - and if nothing has changed then nothing + should get done. This may be because of the args stuff, + i.e. although the arg contents may be the same the args look + different and so are re-applied to the widget. */ +static void +x_button_update (Lisp_Object image_instance) +{ + /* This function can GC if IN_REDISPLAY is false. */ + Lisp_Image_Instance *p = XIMAGE_INSTANCE (image_instance); + widget_value* wv = + gui_items_to_widget_values (image_instance, + IMAGE_INSTANCE_WIDGET_ITEMS (p)); + + /* now modify the widget */ + lw_modify_all_widgets (IMAGE_INSTANCE_X_WIDGET_LWID (p), + wv, True); + free_widget_value_tree (wv); +} + /* get properties of a button */ static Lisp_Object x_button_property (Lisp_Object image_instance, Lisp_Object prop) @@ -2609,9 +2620,7 @@ x_progress_gauge_instantiate (Lisp_Object image_instance, Lisp_Object instantiat { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii); - widget_value* wv = xmalloc_widget_value (); - - button_item_to_widget_value (gui, wv, 1, 1); + widget_value* wv = gui_items_to_widget_values (image_instance, gui); x_widget_instantiate (image_instance, instantiator, pointer_fg, pointer_bg, dest_mask, domain, "progress", wv); @@ -2623,12 +2632,14 @@ x_progress_gauge_update (Lisp_Object image_instance) { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - if (IMAGE_INSTANCE_WIDGET_PERCENT_CHANGED (ii)) + if (IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii)) { Arg al [1]; - /* #### I'm not convinced we should store this in the plist. */ - Lisp_Object val = Fplist_get (IMAGE_INSTANCE_WIDGET_PROPS (ii), - Q_percent, Qnil); + Lisp_Object val; +#ifdef ERROR_CHECK_GLYPHS + assert (GUI_ITEMP (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii))); +#endif + val = XGUI_ITEM (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii))->value; XtSetArg (al[0], XtNvalue, XINT (val)); XtSetValues (IMAGE_INSTANCE_X_WIDGET_ID (ii), al, 1); } @@ -2642,9 +2653,7 @@ x_edit_field_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii); - widget_value* wv = xmalloc_widget_value (); - - button_item_to_widget_value (gui, wv, 1, 1); + widget_value* wv = gui_items_to_widget_values (image_instance, gui); x_widget_instantiate (image_instance, instantiator, pointer_fg, pointer_bg, dest_mask, domain, "text-field", wv); @@ -2664,7 +2673,8 @@ x_combo_box_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, widget_instantiate (image_instance, instantiator, pointer_fg, pointer_bg, dest_mask, domain); - wv = gui_items_to_widget_values (IMAGE_INSTANCE_WIDGET_ITEMS (ii)); + wv = gui_items_to_widget_values (image_instance, + IMAGE_INSTANCE_WIDGET_ITEMS (ii)); x_widget_instantiate (image_instance, instantiator, pointer_fg, pointer_bg, dest_mask, domain, "combo-box", wv); @@ -2678,7 +2688,8 @@ x_tab_control_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); widget_value * wv = - gui_items_to_widget_values (IMAGE_INSTANCE_WIDGET_ITEMS (ii)); + gui_items_to_widget_values (image_instance, + IMAGE_INSTANCE_WIDGET_ITEMS (ii)); update_tab_widget_face (wv, ii, IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)); @@ -2689,12 +2700,12 @@ x_tab_control_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, /* set the properties of a tab control */ static void -x_tab_control_update (Lisp_Object image_instance) +x_tab_control_update (Lisp_Object image_instance) { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); /* Possibly update the face. */ - if (IMAGE_INSTANCE_WIDGET_FACE_CHANGED (ii) + if (IMAGE_INSTANCE_WIDGET_FACE_CHANGED (ii) || XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii))->faces_changed || @@ -2721,9 +2732,7 @@ x_label_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, { Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); Lisp_Object gui = IMAGE_INSTANCE_WIDGET_ITEM (ii); - widget_value* wv = xmalloc_widget_value (); - - button_item_to_widget_value (gui, wv, 1, 1); + widget_value* wv = gui_items_to_widget_values (image_instance, gui); x_widget_instantiate (image_instance, instantiator, pointer_fg, pointer_bg, dest_mask, domain, "button", wv); @@ -2795,6 +2804,7 @@ image_instantiator_format_create_glyphs_x (void) INITIALIZE_DEVICE_IIFORMAT (x, button); IIFORMAT_HAS_DEVMETHOD (x, button, property); IIFORMAT_HAS_DEVMETHOD (x, button, instantiate); + IIFORMAT_HAS_DEVMETHOD (x, button, update); INITIALIZE_DEVICE_IIFORMAT (x, widget); IIFORMAT_HAS_DEVMETHOD (x, widget, property); diff --git a/src/glyphs-x.h b/src/glyphs-x.h index 5f0fa1d..3ef30f3 100644 --- a/src/glyphs-x.h +++ b/src/glyphs-x.h @@ -96,7 +96,7 @@ struct x_subwindow_data Window parent_window; Window clip_window; } sub; - struct + struct { Widget clip_window; Position x_offset; diff --git a/src/glyphs.h b/src/glyphs.h index b405f9e..77ae598 100644 --- a/src/glyphs.h +++ b/src/glyphs.h @@ -550,7 +550,6 @@ struct Lisp_Image_Instance /* Change flags to augment dirty. */ unsigned int face_changed : 1; unsigned int items_changed : 1; - unsigned int percent_changed : 1; } subwindow; } u; @@ -566,7 +565,7 @@ struct Lisp_Image_Instance #define LAYOUT_JUSTIFY_RIGHT 1 #define LAYOUT_JUSTIFY_CENTER 2 -#define IMAGE_INSTANCE_HASH_DEPTH -2 +#define IMAGE_INSTANCE_HASH_DEPTH 0 /* Accessor macros. */ #define IMAGE_INSTANCE_DEVICE(i) ((i)->device) @@ -596,8 +595,6 @@ struct Lisp_Image_Instance ((i)->u.subwindow.face_changed) #define IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED(i) \ ((i)->u.subwindow.items_changed) -#define IMAGE_INSTANCE_WIDGET_PERCENT_CHANGED(i) \ - ((i)->u.subwindow.percent_changed) #define IMAGE_INSTANCE_LAYOUT_CHANGED(i) ((i)->layout_changed) #define IMAGE_INSTANCE_OPTIMIZE_OUTPUT(i) ((i)->optimize_output) @@ -885,12 +882,14 @@ extern Lisp_Object Qtree_view, Qtab_control, Qprogress_gauge, Q_border; extern Lisp_Object Q_mask_file, Q_mask_data, Q_hotspot_x, Q_hotspot_y; extern Lisp_Object Q_foreground, Q_background, Q_face, Q_descriptor, Q_group; extern Lisp_Object Q_width, Q_height, Q_pixel_width, Q_pixel_height, Q_text; -extern Lisp_Object Q_items, Q_properties, Q_image, Q_percent, Qimage_conversion_error; +extern Lisp_Object Q_items, Q_properties, Q_image, Qimage_conversion_error; extern Lisp_Object Q_orientation, Qupdate_widget_instances; +extern Lisp_Object Qwidget_callback_current_channel; extern Lisp_Object Vcontinuation_glyph, Vcontrol_arrow_glyph, Vhscroll_glyph; extern Lisp_Object Vinvisible_text_glyph, Voctal_escape_glyph, Vtruncation_glyph; extern Lisp_Object Vxemacs_logo; + 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); @@ -1013,6 +1012,7 @@ int find_matching_subwindow (struct frame* f, int x, int y, int width, int heigh void update_widget (Lisp_Object widget); void update_subwindow (Lisp_Object subwindow); Lisp_Object image_instance_parent_glyph (struct Lisp_Image_Instance*); +int image_instance_changed (Lisp_Object image); struct expose_ignore { diff --git a/src/gmalloc.c b/src/gmalloc.c index 7358472..dd0f948 100644 --- a/src/gmalloc.c +++ b/src/gmalloc.c @@ -1036,7 +1036,7 @@ realloc (__ptr_t ptr, __malloc_size_t size) int type; __malloc_size_t block, blocks, oldlimit; - if (PURE_DATA(ptr)) + if (PURE_DATA (ptr)) { result = malloc (size); memcpy(result, ptr, size); diff --git a/src/gui-msw.c b/src/gui-msw.c index 415d9e2..9fd0b37 100644 --- a/src/gui-msw.c +++ b/src/gui-msw.c @@ -22,9 +22,11 @@ Boston, MA 02111-1307, USA. */ #include #include "lisp.h" -#include "gui.h" #include "redisplay.h" +#include "gui.h" +#include "glyphs.h" #include "frame.h" +#include "events.h" #include "elhash.h" #include "console-msw.h" #include "buffer.h" @@ -39,26 +41,58 @@ Lisp_Object mswindows_handle_gui_wm_command (struct frame* f, HWND ctrl, LPARAM id) { /* Try to map the command id through the proper hash table */ - Lisp_Object data, fn, arg, frame; + Lisp_Object callback, callback_ex, image_instance, frame, event; + + XSETFRAME (frame, f); /* #### make_int should assert that --kkm */ assert (XINT (make_int (id)) == id); - data = Fgethash (make_int (id), - FRAME_MSWINDOWS_WIDGET_HASH_TABLE (f), Qnil); - - if (NILP (data) || UNBOUNDP (data)) + image_instance = Fgethash (make_int (id), + FRAME_MSWINDOWS_WIDGET_HASH_TABLE1 (f), Qnil); + 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); + + XEVENT (event)->event_type = misc_user_event; + XEVENT (event)->channel = frame; + XEVENT (event)->timestamp = GetTickCount (); + XEVENT (event)->event.eval.function = Qeval; + XEVENT (event)->event.eval.object = + list4 (Qfuncall, callback_ex, image_instance, event); + } + else if (NILP (callback) || UNBOUNDP (callback)) return Qnil; + else + { + Lisp_Object fn, arg; - /* Ok, this is our one. Enqueue it. */ - get_gui_callback (data, &fn, &arg); - XSETFRAME (frame, f); - mswindows_enqueue_misc_user_event (frame, fn, arg); - /* The result of this evaluation could cause other instances to change so - enqueue an update callback to check this. */ - mswindows_enqueue_misc_user_event (frame, Qeval, - list2 (Qupdate_widget_instances, frame)); + event = Fmake_event (Qnil, Qnil); + get_gui_callback (callback, &fn, &arg); + XEVENT (event)->event_type = misc_user_event; + XEVENT (event)->channel = frame; + XEVENT (event)->timestamp = GetTickCount (); + XEVENT (event)->event.eval.function = fn; + XEVENT (event)->event.eval.object = arg; + } + + mswindows_enqueue_dispatch_event (event); + /* The result of this evaluation could cause other instances to change so + enqueue an update callback to check this. We also have to make sure that + the function does not appear in the command history. + #### I'm sure someone can tell me how to optimize this. */ + mswindows_enqueue_misc_user_event + (frame, Qeval, + list3 (Qlet, + list2 (Qthis_command, + Qlast_command), + list2 (Qupdate_widget_instances, frame))); return Qt; } diff --git a/src/gui-x.c b/src/gui-x.c index 2099351..2cade75 100644 --- a/src/gui-x.c +++ b/src/gui-x.c @@ -33,8 +33,10 @@ Boston, MA 02111-1307, USA. */ #include "gui-x.h" #include "buffer.h" #include "device.h" +#include "events.h" #include "frame.h" #include "gui.h" +#include "glyphs.h" #include "redisplay.h" #include "opaque.h" @@ -210,9 +212,8 @@ void popup_selection_callback (Widget widget, LWLIB_ID ignored_id, XtPointer client_data) { - Lisp_Object fn, arg; - Lisp_Object data; - Lisp_Object frame; + Lisp_Object data, image_instance, callback, callback_ex; + Lisp_Object frame, event; int update_subwindows_p = 0; struct device *d = get_device_from_display (XtDisplay (widget)); struct frame *f = x_any_widget_or_parent_to_frame (d, widget); @@ -228,6 +229,10 @@ popup_selection_callback (Widget widget, LWLIB_ID ignored_id, VOID_TO_LISP (data, client_data); XSETFRAME (frame, f); + image_instance = XCAR (data); + callback = XCAR (XCDR (data)); + callback_ex = XCDR (XCDR (data)); + #if 0 /* #### What the hell? I can't understand why this call is here, and doing it is really courting disaster in the new event @@ -241,13 +246,41 @@ popup_selection_callback (Widget widget, LWLIB_ID ignored_id, if (((EMACS_INT) client_data) == -1) { - fn = Qrun_hooks; - arg = Qmenu_no_selection_hook; + event = Fmake_event (Qnil, Qnil); + + XEVENT (event)->event_type = misc_user_event; + XEVENT (event)->channel = frame; + XEVENT (event)->event.eval.function = Qrun_hooks; + XEVENT (event)->event.eval.object = Qmenu_no_selection_hook; } else { update_subwindows_p = 1; - get_gui_callback (data, &fn, &arg); + + if (!NILP (callback_ex) && !UNBOUNDP (callback_ex)) + { + event = Fmake_event (Qnil, Qnil); + + XEVENT (event)->event_type = misc_user_event; + XEVENT (event)->channel = frame; + XEVENT (event)->event.eval.function = Qeval; + XEVENT (event)->event.eval.object = + list4 (Qfuncall, callback_ex, image_instance, event); + } + else if (NILP (callback) || UNBOUNDP (callback)) + event = Qnil; + else + { + Lisp_Object fn, arg; + + event = Fmake_event (Qnil, Qnil); + + get_gui_callback (callback, &fn, &arg); + XEVENT (event)->event_type = misc_user_event; + XEVENT (event)->channel = frame; + XEVENT (event)->event.eval.function = fn; + XEVENT (event)->event.eval.object = arg; + } } /* This is the timestamp used for asserting focus so we need to get an @@ -258,12 +291,19 @@ popup_selection_callback (Widget widget, LWLIB_ID ignored_id, #else DEVICE_X_MOUSE_TIMESTAMP (d) = DEVICE_X_GLOBAL_MOUSE_TIMESTAMP (d); #endif - signal_special_Xt_user_event (frame, fn, arg); + if (!NILP (event)) + enqueue_Xt_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) + enqueue an update callback to check this. We also have to make sure that + the function does not appear in the command history. + #### I'm sure someone can tell me how to optimize this. */ + if (update_subwindows_p && !NILP (event)) signal_special_Xt_user_event (frame, Qeval, - list2 (Qupdate_widget_instances, frame)); + list3 (Qlet, + list2 (Qthis_command, + Qlast_command), + list2 (Qupdate_widget_instances, + frame))); } #if 1 @@ -337,8 +377,10 @@ strdup_and_add_accel (char *name) /* This does the dirty work. gc_currently_forbidden is 1 when this is called. */ int -button_item_to_widget_value (Lisp_Object gui_item, widget_value *wv, - int allow_text_field_p, int no_keys_p) +button_item_to_widget_value (Lisp_Object gui_object_instance, + Lisp_Object gui_item, widget_value *wv, + int allow_text_field_p, int no_keys_p, + int menu_entry_p) { /* !!#### This function has not been Mule-ized */ /* This function cannot GC because gc_currently_forbidden is set when @@ -362,7 +404,7 @@ button_item_to_widget_value (Lisp_Object gui_item, widget_value *wv, signal_simple_error(":filter keyword not permitted on leaf nodes", gui_item); #ifdef HAVE_MENUBARS - if (!gui_item_included_p (gui_item, Vmenubar_configuration)) + if (menu_entry_p && !gui_item_included_p (gui_item, Vmenubar_configuration)) { /* the include specification says to ignore this item. */ return 0; @@ -401,12 +443,14 @@ button_item_to_widget_value (Lisp_Object gui_item, widget_value *wv, wv_set_evalable_slot (wv->enabled, pgui->active); wv_set_evalable_slot (wv->selected, pgui->selected); - if (!NILP (pgui->callback)) - wv->call_data = LISP_TO_VOID (pgui->callback); + if (!NILP (pgui->callback) || !NILP (pgui->callback_ex)) + wv->call_data = LISP_TO_VOID (cons3 (gui_object_instance, + pgui->callback, + pgui->callback_ex)); if (no_keys_p #ifdef HAVE_MENUBARS - || !menubar_show_keybindings + || (menu_entry_p && !menubar_show_keybindings) #endif ) wv->key = 0; @@ -486,10 +530,13 @@ button_item_to_widget_value (Lisp_Object gui_item, widget_value *wv, } /* parse tree's of gui items into widget_value hierarchies */ -static void gui_item_children_to_widget_values (Lisp_Object items, widget_value* parent); +static void gui_item_children_to_widget_values (Lisp_Object gui_object_instance, + Lisp_Object items, + widget_value* parent); static widget_value * -gui_items_to_widget_values_1 (Lisp_Object items, widget_value* parent, +gui_items_to_widget_values_1 (Lisp_Object gui_object_instance, + Lisp_Object items, widget_value* parent, widget_value* prev) { widget_value* wv = 0; @@ -503,7 +550,8 @@ gui_items_to_widget_values_1 (Lisp_Object items, widget_value* parent, parent->contents = wv; else prev->next = wv; - if (!button_item_to_widget_value (items, wv, 0, 1)) + if (!button_item_to_widget_value (gui_object_instance, + items, wv, 0, 1, 0)) { free_widget_value_tree (wv); if (parent) @@ -523,35 +571,40 @@ gui_items_to_widget_values_1 (Lisp_Object items, widget_value* parent, signal_simple_error ("parent item must not be a list", XCAR (items)); if (parent) - wv = gui_items_to_widget_values_1 (XCAR (items), parent, 0); + wv = gui_items_to_widget_values_1 (gui_object_instance, + XCAR (items), parent, 0); else - wv = gui_items_to_widget_values_1 (XCAR (items), 0, prev); + wv = gui_items_to_widget_values_1 (gui_object_instance, + XCAR (items), 0, prev); /* the rest are the children */ - gui_item_children_to_widget_values (XCDR (items), wv); + gui_item_children_to_widget_values (gui_object_instance, + XCDR (items), wv); } return wv; } static void -gui_item_children_to_widget_values (Lisp_Object items, widget_value* parent) +gui_item_children_to_widget_values (Lisp_Object gui_object_instance, + Lisp_Object items, widget_value* parent) { widget_value* wv = 0, *prev = 0; Lisp_Object rest; CHECK_CONS (items); /* first one is master */ - prev = gui_items_to_widget_values_1 (XCAR (items), parent, 0); + prev = gui_items_to_widget_values_1 (gui_object_instance, XCAR (items), + parent, 0); /* the rest are the children */ LIST_LOOP (rest, XCDR (items)) { Lisp_Object tab = XCAR (rest); - wv = gui_items_to_widget_values_1 (tab, 0, prev); + wv = gui_items_to_widget_values_1 (gui_object_instance, tab, 0, prev); prev = wv; } } widget_value * -gui_items_to_widget_values (Lisp_Object items) +gui_items_to_widget_values (Lisp_Object gui_object_instance, Lisp_Object items) { /* !!#### This function has not been Mule-ized */ /* This function can GC */ @@ -575,7 +628,7 @@ gui_items_to_widget_values (Lisp_Object items) wv_closure = make_opaque_ptr (control); record_unwind_protect (widget_value_unwind, wv_closure); - gui_items_to_widget_values_1 (items, control, 0); + gui_items_to_widget_values_1 (gui_object_instance, items, control, 0); /* mess about getting the data we really want */ tmp = control; diff --git a/src/gui-x.h b/src/gui-x.h index f2fa851..d507f69 100644 --- a/src/gui-x.h +++ b/src/gui-x.h @@ -69,9 +69,12 @@ void free_popup_widget_value_tree (widget_value *wv); void popup_selection_callback (Widget widget, LWLIB_ID ignored_id, XtPointer client_data); char *strdup_and_add_accel (char *name); -int button_item_to_widget_value (Lisp_Object desc, widget_value *wv, - int allow_text_field_p, int no_keys_p); -widget_value * gui_items_to_widget_values (Lisp_Object items); +int button_item_to_widget_value (Lisp_Object gui_object_instance, + Lisp_Object gui_item, widget_value *wv, + int allow_text_field_p, int no_keys_p, + int menu_entry_p); +widget_value * gui_items_to_widget_values (Lisp_Object gui_object_instance, + Lisp_Object items); Lisp_Object menu_name_to_accelerator (char *name); char *menu_separator_style (const char *s); Lisp_Object widget_value_unwind (Lisp_Object closure); diff --git a/src/gui.c b/src/gui.c index d1a546e..5705cea 100644 --- a/src/gui.c +++ b/src/gui.c @@ -32,7 +32,7 @@ Boston, MA 02111-1307, USA. */ Lisp_Object Q_active, Q_suffix, Q_keys, Q_style, Q_selected; Lisp_Object Q_filter, Q_config, Q_included, Q_key_sequence; -Lisp_Object Q_accelerator, Q_label, Q_callback; +Lisp_Object Q_accelerator, Q_label, Q_callback, Q_callback_ex, Q_value; Lisp_Object Qtoggle, Qradio; static Lisp_Object parse_gui_item_tree_list (Lisp_Object list); @@ -74,7 +74,13 @@ separator_string_p (const char *s) void get_gui_callback (Lisp_Object data, Lisp_Object *fn, Lisp_Object *arg) { - if (SYMBOLP (data) + 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)) @@ -122,7 +128,9 @@ gui_item_add_keyval_pair (Lisp_Object gui_item, else if (EQ (key, Q_style)) pgui_item->style = val; else if (EQ (key, Q_selected)) pgui_item->selected = val; else if (EQ (key, Q_keys)) pgui_item->keys = val; - else if (EQ (key, Q_callback)) pgui_item->callback = val; + else if (EQ (key, Q_callback)) pgui_item->callback = val; + else if (EQ (key, Q_callback_ex)) pgui_item->callback_ex = val; + else if (EQ (key, Q_value)) pgui_item->value = val; else if (EQ (key, Q_key_sequence)) ; /* ignored for FSF compatibility */ else if (EQ (key, Q_label)) ; /* ignored for 21.0 implement in 21.2 */ else if (EQ (key, Q_accelerator)) @@ -144,6 +152,7 @@ gui_item_init (Lisp_Object gui_item) lp->name = Qnil; lp->callback = Qnil; + lp->callback_ex = Qnil; lp->suffix = Qnil; lp->active = Qt; lp->included = Qt; @@ -153,6 +162,7 @@ gui_item_init (Lisp_Object gui_item) lp->selected = Qnil; lp->keys = Qnil; lp->accelerator = Qnil; + lp->value = Qnil; } Lisp_Object @@ -257,6 +267,8 @@ gui_add_item_keywords_to_plist (Lisp_Object plist, Lisp_Object gui_item) 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)) @@ -275,6 +287,8 @@ gui_add_item_keywords_to_plist (Lisp_Object plist, Lisp_Object gui_item) Fplist_put (plist, Q_keys, pgui_item->keys); if (!NILP (pgui_item->accelerator)) Fplist_put (plist, Q_accelerator, pgui_item->accelerator); + if (!NILP (pgui_item->value)) + Fplist_put (plist, Q_value, pgui_item->value); } /* @@ -482,6 +496,7 @@ mark_gui_item (Lisp_Object obj) 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); @@ -492,50 +507,34 @@ mark_gui_item (Lisp_Object obj) mark_object (p->selected); mark_object (p->keys); mark_object (p->accelerator); + mark_object (p->value); return Qnil; } static unsigned long -gui_item_hash_internal (Lisp_Object obj, int depth) +gui_item_hash (Lisp_Object obj, int depth) { Lisp_Gui_Item *p = XGUI_ITEM (obj); - return HASH2 (HASH5 (internal_hash (p->name, depth + 1), + return HASH2 (HASH6 (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)), - HASH5 (internal_hash (p->config, depth + 1), + HASH6 (internal_hash (p->config, depth + 1), internal_hash (p->filter, depth + 1), internal_hash (p->style, depth + 1), internal_hash (p->selected, depth + 1), - internal_hash (p->keys, depth + 1))); -} - -static unsigned long -gui_item_hash (Lisp_Object obj, int depth) -{ - Lisp_Gui_Item *p = XGUI_ITEM (obj); - - /* Note that this evaluates the active and selected slots so that - the hash changes when the result of these changes. */ - return HASH2 (HASH5 (internal_hash (p->name, depth + 1), - internal_hash (p->callback, depth + 1), - internal_hash (p->suffix, depth + 1), - gui_item_active_p (obj), - internal_hash (p->included, depth + 1)), - HASH5 (internal_hash (p->config, depth + 1), - internal_hash (p->filter, depth + 1), - internal_hash (p->style, depth + 1), - gui_item_selected_p (obj), - internal_hash (p->keys, depth + 1))); + internal_hash (p->keys, depth + 1), + internal_hash (p->value, depth + 1))); } int gui_item_id_hash (Lisp_Object hashtable, Lisp_Object gitem, int slot) { - int hashid = gui_item_hash_internal (gitem, 0); + int hashid = gui_item_hash (gitem, 0); int id = GUI_ITEM_ID_BITS (hashid, slot); while (!NILP (Fgethash (make_int (id), hashtable, Qnil))) @@ -555,6 +554,8 @@ gui_item_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) && internal_equal (p1->callback, p2->callback, depth + 1) && + internal_equal (p1->callback_ex, p2->callback_ex, depth + 1) + && EQ (p1->suffix, p2->suffix) && EQ (p1->active, p2->active) @@ -571,7 +572,9 @@ gui_item_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) && EQ (p1->accelerator, p2->accelerator) && - EQ (p1->keys, p2->keys))) + EQ (p1->keys, p2->keys) + && + EQ (p1->value, p2->value))) return 0; return 1; } @@ -590,6 +593,49 @@ print_gui_item (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) write_c_string (buf, printcharfun); } +static Lisp_Object +copy_gui_item (Lisp_Object gui_item) +{ + Lisp_Object ret = allocate_gui_item (); + Lisp_Gui_Item *lp, *g = XGUI_ITEM (gui_item); + + 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; + lp->config = g->config; + lp->filter = g->filter; + lp->style = g->style; + lp->selected = g->selected; + lp->keys = g->keys; + lp->accelerator = g->accelerator; + lp->value = g->value; + + return ret; +} + +Lisp_Object +copy_gui_item_tree (Lisp_Object arg) +{ + if (CONSP (arg)) + { + Lisp_Object rest = arg = Fcopy_sequence (arg); + while (CONSP (rest)) + { + XCAR (rest) = copy_gui_item_tree (XCAR (rest)); + rest = XCDR (rest); + } + return arg; + } + else if (GUI_ITEMP (arg)) + return copy_gui_item (arg); + else + return arg; +} + /* parse a glyph descriptor into a tree of gui items. The gui_item slot of an image instance can be a single item or an @@ -681,6 +727,8 @@ syms_of_gui (void) defkeyword (&Q_accelerator, ":accelerator"); defkeyword (&Q_label, ":label"); defkeyword (&Q_callback, ":callback"); + defkeyword (&Q_callback_ex, ":callback-ex"); + defkeyword (&Q_value, ":value"); defsymbol (&Qtoggle, "toggle"); defsymbol (&Qradio, "radio"); diff --git a/src/gui.h b/src/gui.h index cdc4a39..9974c9b 100644 --- a/src/gui.h +++ b/src/gui.h @@ -43,6 +43,7 @@ struct Lisp_Gui_Item 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 */ @@ -52,6 +53,7 @@ struct Lisp_Gui_Item Lisp_Object selected; /* Form */ Lisp_Object keys; /* String */ Lisp_Object accelerator; /* Char or Symbol */ + Lisp_Object value; /* Anything you like */ }; DECLARE_LRECORD (gui_item, Lisp_Gui_Item); @@ -63,7 +65,7 @@ DECLARE_LRECORD (gui_item, Lisp_Gui_Item); extern Lisp_Object Q_accelerator, Q_active, Q_config, Q_filter, Q_included; extern Lisp_Object Q_keys, Q_selected, Q_suffix, Qradio, Qtoggle; -extern Lisp_Object Q_key_sequence, Q_label, Q_callback; +extern Lisp_Object Q_key_sequence, Q_label, Q_callback, Q_callback_ex, Q_value; void gui_item_add_keyval_pair (Lisp_Object, Lisp_Object key, Lisp_Object val, @@ -85,6 +87,7 @@ unsigned int 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); /* this is mswindows biased but reasonably safe I think */ #define GUI_ITEM_ID_SLOTS 8 diff --git a/src/hpplay.c b/src/hpplay.c index b7014b8..d0a1bce 100644 --- a/src/hpplay.c +++ b/src/hpplay.c @@ -51,6 +51,8 @@ Boston, MA 02111-1307, USA. */ #include #include "lisp.h" +#include "nativesound.h" + #include #include #ifdef HPUX10 @@ -61,6 +63,7 @@ Boston, MA 02111-1307, USA. */ #include