changeset 233:52952cbfc5b5 r20-5b15

Import from CVS: tag r20-5b15
author cvs
date Mon, 13 Aug 2007 10:14:14 +0200
parents aa6545ea0638
children 946e7f6ce379
files CHANGES-beta ChangeLog Makefile.in etc/categories lisp/ChangeLog lisp/about.el lisp/auto-autoloads.el lisp/dumped-lisp.el lisp/help.el lisp/loaddefs.el lisp/loadhist.el lisp/packages.el lisp/x-menubar.el nt/ChangeLog nt/config.h src/ChangeLog src/alloc.c src/bytecode.h src/console-msw.h src/data.c src/emacs.c src/emacsfns.h src/event-msw.c src/event-msw.h src/free-hook.c src/linuxplay.c src/lread.c src/menubar-msw.c src/menubar-msw.h src/msw-proc.c src/print.c src/process.c src/regex.c src/sound.c version.sh
diffstat 35 files changed, 578 insertions(+), 182 deletions(-) [+]
line wrap: on
line diff
--- a/CHANGES-beta	Mon Aug 13 10:13:49 2007 +0200
+++ b/CHANGES-beta	Mon Aug 13 10:14:14 2007 +0200
@@ -1,4 +1,13 @@
 							-*- indented-text -*-
+to 20.5 beta15 "British Alpine"
+-- autoloads are now loaded into impure storage and can be deleted at runtime
+-- loadhist.el is now dumped with XEmacs
+-- XEmacs running in place as a login shell now works
+-- loadhist.el unpackaged
+-- COMPILED_FUNCTION_ANNOTATION disabled
+-- Added new compile time symbols -- LOADHIST_DUMPED and LOADHIST_BUILTIN
+   adapted from code originally by Tomasz Cholewo
+
 to 20.5 beta14 "Booted Goat"
 -- help.el update courtesy of Jens Petersen
 -- Image error handling courtesy of Jareth Hein
--- a/ChangeLog	Mon Aug 13 10:13:49 2007 +0200
+++ b/ChangeLog	Mon Aug 13 10:14:14 2007 +0200
@@ -1,3 +1,11 @@
+1997-12-30  SL Baur  <steve@altair.xemacs.org>
+
+	* XEmacs 20.5-beta15 is released.
+
+1997-12-29  SL Baur  <steve@altair.xemacs.org>
+
+	* Makefile.in (${SUBDIR}): Remove bogus .RECURSIVE dependency.
+
 1997-12-27  SL Baur  <steve@altair.xemacs.org>
 
 	* XEmacs 20.5-beta14 is released.
--- a/Makefile.in	Mon Aug 13 10:13:49 2007 +0200
+++ b/Makefile.in	Mon Aug 13 10:14:14 2007 +0200
@@ -346,8 +346,6 @@
 FRC.src FRC.lib-src FRC.lwlib FRC.dynodump pkg-src/FRC.tree-x:
 FRC.lisp.finder-inf.el:
 
-.RECURSIVE: ${SUBDIR}
-
 ${SUBDIR}: ${SUBDIR_MAKEFILES} ${GENERATED_HEADERS} FRC
 	cd $@ && $(RECURSIVE_MAKE) all
 
--- a/etc/categories	Mon Aug 13 10:13:49 2007 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,41 +0,0 @@
-#		    Possible categories for a PR.
-#
-# Any line which begins with a `#' is considered a comment, and GNATS
-# will ignore it. 
-#
-# Each entry has the format:
-#
-# 	category:description:responsible:notify
-#
-# * `category' is the name of the classification for the PR.
-# * `description' can be a normal text description for the
-#   category, like "Development Tools" for the `tools' category.
-# * `responsible' gives the name (which can be found in the remote
-#   file) of the person who will be given responsibility for any PR
-#   appearing in this category.
-# * `notify' are other email addresses which should be given copies of
-#    any PR in this category.
-#
-# The following category is mandatory for GNATS to work.
-#
-pending:Category for faulty PRs:gnats-admin:
-#
-# Sample categories:
-#
-auxiliary:Auxiliary Programs:gnats-admin:
-configuration:Configuration:gnats-admin:mrb@eng.sun.com
-documentation:Documentation Bug:gnats-admin:weiner@infodock.com
-frames:X11 Frames:gnats-admin:
-i18n:I18n Internationalization:martin:
-lisp:Emacs Lisp code:gnats-admin:
-menubars:X11 menubars:gnats-admin:
-misc:Miscellaneous:gnats-admin:
-mule:MULE Internationalization stuffs:jhod:
-performance:Performance Issues:dmoore:
-redisplay:Redisplay Issues:gnats-admin:cthomp@xemacs.org
-scrollbars:X11 scrollbars:gnats-amdin:mrb@eng.sun.com
-subprocesses:All Subprocess stuff:dmoore:
-toolbars:X11 toolbars:gnats-admin:
-gnus:Gnus newsreader:larsi:
-vm:VM Mailreader:kyle:
-W3:W3 Browser:wmperry:
--- a/lisp/ChangeLog	Mon Aug 13 10:13:49 2007 +0200
+++ b/lisp/ChangeLog	Mon Aug 13 10:14:14 2007 +0200
@@ -1,3 +1,28 @@
+1997-12-29  Colin Rafferty  <colin@xemacs.org>
+
+	* packages.el (packages-find-packages-1): Made it signal a warning 
+	for an error in an auto-autoload.el file.
+
+1997-12-30  SL Baur  <steve@altair.xemacs.org>
+
+	* x-menubar.el (buffers-menu-submenus-for-groups-p): Replace sexp
+	tag with const.
+	From Aki Vehtari <Aki.Vehtari@hut.fi>
+
+	* dumped-lisp.el (preloaded-file-list): Dump loadhist with XEmacs.
+
+	* loadhist.el (unload-feature): Remove autoload.
+
+1997-12-28  SL Baur  <steve@altair.xemacs.org>
+
+	* loadhist.el: Unpackaged.
+
+	* help.el (describe-symbol-find-file): Rename
+	`describe-function-find-file' and make old name obsolete.
+	(describe-function-1): Use it.
+	(describe-function-1): Guard reference to
+	`compiled-function-annotation'.
+
 1997-12-27  Jens-Ulrik Holger Petersen  <petersen@kurims.kyoto-u.ac.jp>
 
 	* help.el (help-mode-bury): Now a call to `help-mode-quit' with
--- a/lisp/about.el	Mon Aug 13 10:13:49 2007 +0200
+++ b/lisp/about.el	Mon Aug 13 10:14:14 2007 +0200
@@ -1411,6 +1411,7 @@
        (print-short "Juan E. Villacis" "jvillaci@cs.indiana.edu")
        (print-short "Jan Vroonhof" "vroonhof@math.ethz.ch")
        (print-short "Vladimir Vukicevic" "vladimir@intrepid.com")
+       (print-short "Charles G. Waldman" "cgw@pgt.com")
        (print-short "David Walte" "djw18@cornell.edu")
        (print-short "Peter Ware" "ware@cis.ohio-state.edu")
        (print-short "Yoav Weiss" "yoav@zeus.datasrv.co.il")
--- a/lisp/auto-autoloads.el	Mon Aug 13 10:13:49 2007 +0200
+++ b/lisp/auto-autoloads.el	Mon Aug 13 10:14:14 2007 +0200
@@ -1152,6 +1152,15 @@
 
 ;;;***
 
+;;;### (autoloads (unload-feature) "loadhist" "lisp/loadhist.el")
+
+(autoload 'unload-feature "loadhist" "\
+Unload the library that provided FEATURE, restoring all its autoloads.
+If the feature is required by any other loaded code, and optional FORCE
+is nil, raise an error." t nil)
+
+;;;***
+
 ;;;### (autoloads (package-admin-add-binary-package package-admin-add-single-file-package) "package-admin" "lisp/package-admin.el")
 
 (autoload 'package-admin-add-single-file-package "package-admin" "\
@@ -1348,6 +1357,28 @@
 
 ;;;***
 
+;;;### (autoloads (ask-user-about-supersession-threat ask-user-about-lock) "userlock" "lisp/userlock.el")
+
+(autoload 'ask-user-about-lock "userlock" "\
+Ask user what to do when he wants to edit FILE but it is locked by USER.
+This function has a choice of three things to do:
+  do (signal 'file-locked (list FILE USER))
+    to refrain from editing the file
+  return t (grab the lock on the file)
+  return nil (edit the file even though it is locked).
+You can rewrite it to use any criterion you like to choose which one to do." nil nil)
+
+(autoload 'ask-user-about-supersession-threat "userlock" "\
+Ask a user who is about to modify an obsolete buffer what to do.
+This function has two choices: it can return, in which case the modification
+of the buffer will proceed, or it can (signal 'file-supersession (file)),
+in which case the proposed buffer modification will not be made.
+
+You can rewrite this to use any criterion you like to choose which one to do.
+The buffer in question is current when this function is called." nil nil)
+
+;;;***
+
 ;;;### (autoloads (auto-view-mode view-major-mode view-mode view-minor-mode view-buffer-other-window view-file-other-window view-buffer view-file) "view-less" "lisp/view-less.el")
 
 (defvar view-minor-mode-map (let ((map (make-keymap))) (set-keymap-name map 'view-minor-mode-map) (suppress-keymap map) (define-key map "-" 'negative-argument) (define-key map " " 'scroll-up) (define-key map "f" 'scroll-up) (define-key map "b" 'scroll-down) (define-key map 'backspace 'scroll-down) (define-key map 'delete 'scroll-down) (define-key map "
" 'view-scroll-lines-up) (define-key map "\n" 'view-scroll-lines-up) (define-key map "e" 'view-scroll-lines-up) (define-key map "j" 'view-scroll-lines-up) (define-key map "y" 'view-scroll-lines-down) (define-key map "k" 'view-scroll-lines-down) (define-key map "d" 'view-scroll-some-lines-up) (define-key map "u" 'view-scroll-some-lines-down) (define-key map "r" 'recenter) (define-key map "t" 'toggle-truncate-lines) (define-key map "N" 'view-buffer) (define-key map "E" 'view-file) (define-key map "P" 'view-buffer) (define-key map "!" 'shell-command) (define-key map "|" 'shell-command-on-region) (define-key map "=" 'what-line) (define-key map "?" 'view-search-backward) (define-key map "h" 'view-mode-describe) (define-key map "s" 'view-repeat-search) (define-key map "n" 'view-repeat-search) (define-key map "/" 'view-search-forward) (define-key map "\\" 'view-search-backward) (define-key map "g" 'view-goto-line) (define-key map "G" 'view-last-windowful) (define-key map "%" 'view-goto-percent) (define-key map "p" 'view-goto-percent) (define-key map "m" 'point-to-register) (define-key map "'" 'register-to-point) (define-key map "C" 'view-cleanup-backspaces) (define-key map "" 'view-quit) (define-key map "" 'view-quit-toggle-ro) (define-key map "q" 'view-quit) map))
--- a/lisp/dumped-lisp.el	Mon Aug 13 10:13:49 2007 +0200
+++ b/lisp/dumped-lisp.el	Mon Aug 13 10:14:14 2007 +0200
@@ -192,5 +192,6 @@
 ;;	#+sparcworks "sun-eos-debugger"
 ;;	#+sparcworks "sun-eos-debugger-extra"
 ;;	#+sparcworks "sun-eos-menubar"
+	"loadhist"		; Must be dumped before loaddefs is loaded
 	"loaddefs"		; <=== autoloads get loaded here
 ))
--- a/lisp/help.el	Mon Aug 13 10:13:49 2007 +0200
+++ b/lisp/help.el	Mon Aug 13 10:14:14 2007 +0200
@@ -830,7 +830,7 @@
   :type 'boolean
   :group 'help-appearance)
 
-(defun describe-function-find-file (function)
+(defun describe-symbol-find-file (function)
   (let ((files load-history)
 	file)
     (while files
@@ -839,6 +839,9 @@
 		files nil))
       (setq files (cdr files)))
     file))
+(define-obsolete-function-alias
+  'describe-function-find-file
+  'describe-symbol-find-file)
 
 (defun describe-function (function)
   "Display the full documentation of FUNCTION (a symbol).
@@ -969,11 +972,13 @@
 			   (symbol-name def)))
 		(format "an alias for `%s', " (symbol-name def)))))
       (setq def (symbol-function def)))
-    (if (compiled-function-p def)
+    (if (and (fboundp 'compiled-function-annotation)
+	     (compiled-function-p def))
 	(setq file-name (compiled-function-annotation def)))
     (if (eq 'macro (car-safe def))
 	(setq fndef (cdr def)
 	      file-name (and (compiled-function-p (cdr def))
+			     (fboundp 'compiled-function-annotation)
 			     (compiled-function-annotation (cdr def)))
 	      macrop t)
       (setq fndef def))
@@ -1014,7 +1019,7 @@
     (if autoload-file
 	(princ (format "  -- autoloads from \"%s\"\n" autoload-file)))
     (or file-name
-	(setq file-name (describe-function-find-file function)))
+	(setq file-name (describe-symbol-find-file function)))
     (if file-name
 	(princ (format "  -- loaded from \"%s\"\n" file-name)))
 ;;     (terpri)
@@ -1171,7 +1176,7 @@
 	    (princ (format "%s" aliases)))
 	(princ (built-in-variable-doc variable))
 	(princ ".\n")
-	(let ((file-name (describe-function-find-file variable)))
+	(let ((file-name (describe-symbol-find-file variable)))
 	     (if file-name
 		 (princ (format "  -- loaded from \"%s\"\n" file-name))))
 	(princ "\nValue: ")
--- a/lisp/loaddefs.el	Mon Aug 13 10:13:49 2007 +0200
+++ b/lisp/loaddefs.el	Mon Aug 13 10:14:14 2007 +0200
@@ -164,15 +164,12 @@
 (make-variable-buffer-local 'indent-tabs-mode)
 
 
-;;; This code also was not generated by autoload.el, because VM goes out
-;;; of its way to be perverse.
-
-
 ;;; Load in generated autoloads (made by autoload.el).
 ;; (condition-case nil
     ;; (load "auto-autoloads")
   ;; (file-error nil))
-(let ((dir load-path))
+(let ((dir load-path)
+      purify-flag)
   (while dir
     (condition-case nil
 	(load (concat (car dir) "auto-autoloads"))
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/loadhist.el	Mon Aug 13 10:14:14 2007 +0200
@@ -0,0 +1,155 @@
+;;; loadhist.el --- lisp functions for working with feature groups
+
+;; Copyright (C) 1995 Free Software Foundation, Inc.
+
+;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
+;; Version: 1.0
+;; Keywords: internal, dumped
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: FSF 20.2.
+
+;;; Commentary:
+
+;; This file is dumped with XEmacs.
+
+;; These functions exploit the load-history system variable.
+;; Entry points include `unload-feature', `symbol-file', and `feature-file'.
+
+;;; Code:
+
+(defun symbol-file (sym)
+  "Return the input source from which SYM was loaded.
+This is a file name, or nil if the source was a buffer with no associated file."
+  (interactive "S") ; XEmacs
+  (catch 'foundit
+    (mapcar
+     (function (lambda (x) (if (memq sym (cdr x)) (throw 'foundit (car x)))))
+     load-history)
+    nil))
+
+(defun feature-symbols (feature)
+  "Return the file and list of symbols associated with a given FEATURE."
+   (catch 'foundit
+     (mapcar
+      (function (lambda (x) 
+		  (if (member (cons 'provide feature) (cdr x))
+		      (throw 'foundit x))))
+      load-history)
+     nil))
+
+(defun feature-file (feature)
+  "Return the file name from which a given FEATURE was loaded.
+Actually, return the load argument, if any; this is sometimes the name of a
+Lisp file without an extension.  If the feature came from an eval-buffer on
+a buffer with no associated file, or an eval-region, return nil."
+  (if (not (featurep feature))
+      (error "%s is not a currently loaded feature" (symbol-name feature))
+    (car (feature-symbols feature))))
+
+(defun file-provides (file)
+  "Return the list of features provided by FILE."
+  (let ((symbols (cdr (assoc file load-history))) (provides nil))
+    (mapcar
+     (function (lambda (x)
+		 (if (and (consp x) (eq (car x) 'provide))
+		     (setq provides (cons (cdr x) provides)))))
+     symbols)
+    provides
+    ))
+
+(defun file-requires (file)
+  "Return the list of features required by FILE."
+  (let ((symbols (cdr (assoc file load-history))) (requires nil))
+    (mapcar
+     (function (lambda (x)
+		 (if (and (consp x) (eq (car x) 'require))
+		     (setq requires (cons (cdr x) requires)))))
+     symbols)
+    requires
+    ))
+
+(defun file-set-intersect (p q)
+  ;; Return the set intersection of two lists
+  (let ((ret nil))
+    (mapcar
+     (function (lambda (x) (if (memq x q) (setq ret (cons x ret)))))
+     p)
+    ret
+    ))
+
+(defun file-dependents (file)
+  "Return the list of loaded libraries that depend on FILE.
+This can include FILE itself."
+  (let ((provides (file-provides file)) (dependents nil))
+    (mapcar
+     (function (lambda (x) 
+		 (if (file-set-intersect provides (file-requires (car x)))
+		     (setq dependents (cons (car x) dependents)))))
+     load-history)
+    dependents
+    ))
+
+;; FSFmacs
+;(defun read-feature (prompt)
+;  "Read a feature name \(string\) from the minibuffer,
+;prompting with PROMPT and completing from `features', and
+;return the feature \(symbol\)."
+;  (intern (completing-read prompt
+;			   (mapcar (function (lambda (feature)
+;					       (list (symbol-name feature))))
+;				   features)
+;			   nil t)))
+
+;; ;;;###autoload
+(defun unload-feature (feature &optional force)
+  "Unload the library that provided FEATURE, restoring all its autoloads.
+If the feature is required by any other loaded code, and optional FORCE
+is nil, raise an error."
+  (interactive "SFeature: ")
+  (if (not (featurep feature))
+      (error "%s is not a currently loaded feature" (symbol-name feature)))
+  (if (not force)
+      (let* ((file (feature-file feature))
+	     (dependents (delete file (copy-sequence (file-dependents file)))))
+	(if dependents
+	    (error "Loaded libraries %s depend on %s"
+		   (prin1-to-string dependents) file)
+	    )))
+  (let* ((flist (feature-symbols feature)) (file (car flist)))
+    (mapcar
+     (function (lambda (x) 
+		 (cond ((stringp x) nil)
+		       ((consp x)
+			;; Remove any feature names that this file provided.
+			(if (eq (car x) 'provide)
+			    (setq features (delq (cdr x) features))))
+		       ((boundp x) (makunbound x))
+		       ((fboundp x)
+			(fmakunbound x)
+			(let ((aload (get x 'autoload)))
+			  (if aload (fset x (cons 'autoload aload))))))))
+     (cdr flist))
+    ;; Delete the load-history element for this file.
+    (let ((elt (assoc file load-history)))
+      (setq load-history (delq elt load-history)))))
+
+(provide 'loadhist)
+
+;;; loadhist.el ends here
--- a/lisp/packages.el	Mon Aug 13 10:13:49 2007 +0200
+++ b/lisp/packages.el	Mon Aug 13 10:14:14 2007 +0200
@@ -224,10 +224,15 @@
 			      (append dumped-lisp-packages package-lisp)))))))
 
 	(if user-package
-	    (condition-case nil
+	    (condition-case error
 		(load (concat package "/lisp/"
-			      (file-name-sans-extension autoload-file-name)))
-	      (t nil)))
+			      (file-name-sans-extension autoload-file-name))
+		      t)
+	      (error
+	       (warn (format "Autoload error in: %s/lisp/:\n\t%s"
+			     package
+			     (with-output-to-string
+			       (display-error error nil)))))))
 	(let ((dirs (directory-files (concat package "/lisp/")
 				     t "^[^-.]" nil 'dirs-only))
 	      dir)
@@ -254,15 +259,20 @@
 				  (append dumped-lisp-packages package-lisp)))))))
 
 	    (if user-package
-		(condition-case nil
+		(condition-case error
 		    (progn
 ;		      (print
 ;		       (concat dir "/"
 ;			       (file-name-sans-extension autoload-file-name)))
 		      (load
 		       (concat dir "/"
-			       (file-name-sans-extension autoload-file-name))))
-		  (t nil)))
+			       (file-name-sans-extension autoload-file-name))
+		       t))
+		  (error
+		   (warn (format "Autoload error in: %s/:\n\t%s"
+				 dir
+				 (with-output-to-string
+				   (display-error error nil)))))))
 	    (packages-find-packages-1 dir path-only append-p user-package)
 	    (setq dirs (cdr dirs)))))))
 
--- a/lisp/x-menubar.el	Mon Aug 13 10:13:49 2007 +0200
+++ b/lisp/x-menubar.el	Mon Aug 13 10:14:14 2007 +0200
@@ -989,7 +989,7 @@
 is not larger than this value."
   :type '(choice (const :tag "No Subgroups" nil)
 		 (integer :tag "Max. submenus" 10)
-		 (sexp :format "%t\n" :tag "Allow Subgroups"))
+		 (const :tag "Allow Subgroups" t))
   :group 'buffers-menu)
 
 (defcustom buffers-menu-switch-to-buffer-function 'switch-to-buffer
--- a/nt/ChangeLog	Mon Aug 13 10:13:49 2007 +0200
+++ b/nt/ChangeLog	Mon Aug 13 10:14:14 2007 +0200
@@ -1,3 +1,10 @@
+1997-12-29  Kirill M. Katsnelson  <kkm@kis.ru>
+
+	* config.h: Suppressed MSVC warning 'relational' : signed/unsigned
+	mismatch
+
+	* config.h: INLINE defined to __inline for MSVC compilers >= 2.x
+
 1997-12-26  Kirill M. Katsnelson  <kkm@kis.ru>
 
 	* xemacs.mak: added menubar-msw.c, menubar.c
--- a/nt/config.h	Mon Aug 13 10:13:49 2007 +0200
+++ b/nt/config.h	Mon Aug 13 10:14:14 2007 +0200
@@ -640,20 +640,24 @@
 #define LONGBITS (8 * SIZEOF_LONG)
 #endif
 
-#ifdef HAVE_INLINE
-# if defined (__GNUC__)
-#  if defined (DONT_EXTERN_INLINE_FUNCTIONS)
-#   define INLINE inline
-#  else
-#   define INLINE extern inline
-#  endif
-# else
-#  define INLINE static inline
-# endif
+/* MSVC version >= 2.x without /Za supports __inline */
+#if (_MSC_VER < 900) || defined(__STDC__)
+# define INLINE static
 #else
-# define INLINE static
+# define INLINE __inline
 #endif
 
+/* MSVC warnings no-no crap. When adding one to this section,
+   1. Think twice
+   2. Insert textual description of the warning.
+   3. Think twice. Undo still works  */
+#if (_MSC_VER >= 800)
+
+/* 'expression' : signed/unsigned mismatch */
+#pragma warning ( disable : 4018 )
+
+#endif /* compiler understands #pragma warning*/
+
 /* We want to avoid saving the signal mask if possible, because
    that necessitates a system call. */
 #ifdef HAVE_SIGSETJMP
--- a/src/ChangeLog	Mon Aug 13 10:13:49 2007 +0200
+++ b/src/ChangeLog	Mon Aug 13 10:14:14 2007 +0200
@@ -1,3 +1,60 @@
+1997-12-29  Kirill M. Katsnelson  <kkm@kis.ru>
+
+	* msw-proc.c (mswindows_enqueue_magic_event): Made extern. User by 
+	menubar-msw.c
+
+	* event-msw.h: Prototype for mswindows_enqueue_magic_event
+
+	* event-msw.c (mswindows_wm_timer_callback): Fixed counter of
+	outstanding timer events (decremented only when KillTimer
+	succeeds)
+	(emacs_mswindows_remove_timeout): Ditto
+
+	* console-msw.h: Added frame structure field for menu checksum
+
+	* menubar-msw.c: Miscellaneous patches and bug fixes.
+
+1997-12-30  SL Baur  <steve@altair.xemacs.org>
+
+	* emacs.c (main): Clarify calls to main_1.
+
+	* data.c (Fcompiled_function_annotation): Hide DEFUN from
+	make-docfile.
+
+	* emacs.c (main_1): The invocation name requires recomputing when
+	running after dumping.
+
+1997-12-29  SL Baur  <steve@altair.xemacs.org>
+
+	* free-hook.c (check_free): Added explicit braces to avoid
+	dangling else clause.
+	* sound.c (Fplay_sound_file): Ditto.
+	* process.c (set_process_filter): Ditto.
+	* linuxplay.c (linux_play_data_or_file): Ditto.
+	* regex.c (regex_compile): Ditto.
+
+1997-12-28  SL Baur  <steve@altair.xemacs.org>
+
+	* emacs.c (main_1): Fix logic to run in place when XEmacs is a
+	login shell.
+	(main_1): New parameter restart.
+	(main): Use it.
+
+	* bytecode.h: Disable COMPILED_FUNCTION_ANNOTATION_HACK.
+
+	* print.c (debug_short_backtrace): Guard call to
+	Fcompiled_function_annotation.
+
+	* alloc.c (disksave_object_finalization): Don't zero out
+	load-history if history of pure symbols is desired.
+
+	* lread.c (build_load_history): If LOADHIST_DUMPED is defined, add 
+	pure symbols to load-history.
+
+	* emacsfns.h: New symbols added -- LOADHIST_DUMPED, define to get
+	a history of dumped lisp.  LOADHIST_BUILTIN, define to get a
+	history of symbols defined in C source.
+
 1997-12-23  Andy Piper <andyp@parallax.co.uk>
 
 	* Conditionals to enable XEmacs to compile (not run!) under
--- a/src/alloc.c	Mon Aug 13 10:13:49 2007 +0200
+++ b/src/alloc.c	Mon Aug 13 10:14:14 2007 +0200
@@ -4192,7 +4192,10 @@
   Vexec_path = Qnil;
   Vload_path = Qnil;
   /* Vdump_load_path = Qnil; */
+#if defined(LOADHIST) && !(defined(LOADHIST_DUMPED) || \
+			   defined(LOADHIST_BUILTIN))
   Vload_history = Qnil;
+#endif
   Vshell_file_name = Qnil;
 
   garbage_collect_1 ();
--- a/src/bytecode.h	Mon Aug 13 10:13:49 2007 +0200
+++ b/src/bytecode.h	Mon Aug 13 10:14:14 2007 +0200
@@ -39,7 +39,8 @@
 #define COMPILED_INTERACTIVE 5
 #define COMPILED_DOMAIN 6
 
-#define COMPILED_FUNCTION_ANNOTATION_HACK
+/* It doesn't make sense to have this and also have load-history */
+/* #define COMPILED_FUNCTION_ANNOTATION_HACK */
 
 struct Lisp_Compiled_Function
 {
--- a/src/console-msw.h	Mon Aug 13 10:13:49 2007 +0200
+++ b/src/console-msw.h	Mon Aug 13 10:14:14 2007 +0200
@@ -77,8 +77,11 @@
   /* Coordinates of last click event, screen-relative */
   POINTS last_click_point;
 
-  /* Menu hashtable. See menubar-msw.h */
-  Lisp_Object hash_table;
+  /* Menu hashtable. See menubar-msw.c */
+  Lisp_Object menu_hashtable;
+
+  /* Menu checksum. See menubar-msw.c */
+  unsigned int menu_checksum;
 
   /* Misc flags */
   int button2_need_lbutton : 1;
@@ -91,9 +94,10 @@
 
 #define FRAME_MSWINDOWS_DATA(f) FRAME_TYPE_DATA (f, mswindows)
 
-#define FRAME_MSWINDOWS_HANDLE(f)	(FRAME_MSWINDOWS_DATA (f)->hwnd)
-#define FRAME_MSWINDOWS_DC(f)		(FRAME_MSWINDOWS_DATA (f)->hdc)
-#define FRAME_MSWINDOWS_MENU_HASHTABLE(f) (FRAME_MSWINDOWS_DATA (f)->hash_table)
+#define FRAME_MSWINDOWS_HANDLE(f)	  (FRAME_MSWINDOWS_DATA (f)->hwnd)
+#define FRAME_MSWINDOWS_DC(f)		  (FRAME_MSWINDOWS_DATA (f)->hdc)
+#define FRAME_MSWINDOWS_MENU_HASHTABLE(f) (FRAME_MSWINDOWS_DATA (f)->menu_hashtable)
+#define FRAME_MSWINDOWS_MENU_CHECKSUM(f)  (FRAME_MSWINDOWS_DATA (f)->menu_checksum)
 
 /*
  * Redisplay functions
--- a/src/data.c	Mon Aug 13 10:13:49 2007 +0200
+++ b/src/data.c	Mon Aug 13 10:14:14 2007 +0200
@@ -971,7 +971,8 @@
 
 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
 
-DEFUN ("compiled-function-annotation", Fcompiled_function_annotation, 1, 1, 0, /*
+/* Remove the `xx' if you wish to restore this feature */
+xxDEFUN ("compiled-function-annotation", Fcompiled_function_annotation, 1, 1, 0, /*
 Return the annotation of the compiled-function object, or nil.
 The annotation is a piece of information indicating where this
 compiled-function object came from.  Generally this will be
--- a/src/emacs.c	Mon Aug 13 10:13:49 2007 +0200
+++ b/src/emacs.c	Mon Aug 13 10:14:14 2007 +0200
@@ -460,7 +460,7 @@
 #define main_1 STACK_TRACE_EYE_CATCHER
 
 static DOESNT_RETURN
-main_1 (int argc, char **argv, char **envp)
+main_1 (int argc, char **argv, char **envp, int restart)
 {
   char stack_bottom_variable;
   int skip_args = 0;
@@ -1438,8 +1438,14 @@
   init_console_stream (); /* Create the first console */
 
   /* try to get the actual pathname of the exec file we are running */
+  if (!restart)
   {
     Vinvocation_name = Fcar (Vcommand_line_args);
+    if (XSTRING_DATA(Vinvocation_name)[0] == '-')
+      {
+	/* XEmacs as a login shell, oh goody! */
+	Vinvocation_name = build_string(getenv("SHELL"));
+      }
     Vinvocation_directory = Vinvocation_name;
 
     if (!NILP (Ffile_name_directory (Vinvocation_name)))
@@ -1796,6 +1802,29 @@
   int     volatile vol_argc = argc;
   char ** volatile vol_argv = argv;
   char ** volatile vol_envp = envp;
+  /* This is hairy.  We need to compute where the XEmacs binary was invoked */
+  /* from because temacs initialization requires it to find the lisp */
+  /* directories.  The code that recomputes the path is guarded by the */
+  /* restarted flag.  There are three possible paths I've found so far */
+  /* through this: */
+  /* temacs -- When running temacs for basic build stuff, the first main_1 */
+  /*  will be the only one invoked.  It must compute the path else there */
+  /*  will be a very ugly bomb in startup.el (can't find obvious location */
+  /*  for doc-directory data-directory, etc.).  */
+  /* temacs w/ run-temacs on the command line -- This is run to bytecompile */
+  /*  all the out of date dumped lisp.  It will execute both of the main_1 */
+  /*  calls and the second one must not touch the first computation because */
+  /*  argc/argv are hosed the second time through. */
+  /* xemacs -- Only the second main_1 is executed.  The invocation path must */
+  /*  computed but this only matters when running in place or when running */
+  /*  as a login shell. */
+  /* As a bonus for straightening this out, XEmacs can now be run in place */
+  /*  as a login shell.  This never used to work. */
+  /* As another bonus, we can now guarantee that */
+  /* (concat invocation-directory invocation-name) contains the filename */
+  /* of the XEmacs binary we are running.  This can now be used in a */
+  /* definite test for out of date dumped files.  -slb */
+  int restarted = 0;
 #ifdef QUANTIFY
   quantify_stop_recording_data ();
   quantify_clear_data ();
@@ -1811,8 +1840,11 @@
     {
       run_temacs_argc = 0;
       if (! SETJMP (run_temacs_catch))
-	main_1 (vol_argc, vol_argv, vol_envp);
+	{
+	  main_1 (vol_argc, vol_argv, vol_envp, 0);
+	}
       /* run-emacs-from-temacs called */
+      restarted = 1;
       vol_argc = run_temacs_argc;
       vol_argv = run_temacs_argv;
 #ifdef _SCO_DS
@@ -1839,7 +1871,7 @@
     }
   run_temacs_argc = -1;
 
-  main_1 (vol_argc, vol_argv, vol_envp);
+  main_1 (vol_argc, vol_argv, vol_envp, restarted);
   return 0; /* unreached */
 }
 
--- a/src/emacsfns.h	Mon Aug 13 10:13:49 2007 +0200
+++ b/src/emacsfns.h	Mon Aug 13 10:14:14 2007 +0200
@@ -1396,7 +1396,12 @@
 int isfloat_string (CONST char *);
 
 /* Well, I've decided to enable this. -- ben */
+/* And I've decided to make it work right.  -- sb */
 #define LOADHIST
+/* Define the following symbol to enable load history of dumped files */
+#define LOADHIST_DUMPED
+/* Define the following symbol to enable load history of C source */
+#define LOADHIST_BUILTIN
 
 #ifdef LOADHIST /* this is just a stupid idea */
 #define LOADHIST_ATTACH(x) \
--- a/src/event-msw.c	Mon Aug 13 10:13:49 2007 +0200
+++ b/src/event-msw.c	Mon Aug 13 10:14:14 2007 +0200
@@ -391,8 +391,8 @@
   Lisp_Object emacs_event = Fmake_event (Qnil, Qnil);
   struct Lisp_Event *event = XEVENT (emacs_event);
 
-  KillTimer (NULL, id_timer);
-  --mswindows_pending_timers_count;
+  if (KillTimer (NULL, id_timer))
+    --mswindows_pending_timers_count;
 
   event->channel = Qnil;
   event->timestamp = dwtime;
@@ -560,8 +560,8 @@
   struct Lisp_Event match_against;
   Lisp_Object emacs_event;
 
-  KillTimer (NULL, id);
-  --mswindows_pending_timers_count;
+  if (KillTimer (NULL, id))
+    --mswindows_pending_timers_count;
 
   /* If there is a dispatch event generated by this
      timeout in the queue, we have to remove it too. */
--- a/src/event-msw.h	Mon Aug 13 10:13:49 2007 +0200
+++ b/src/event-msw.h	Mon Aug 13 10:14:14 2007 +0200
@@ -60,7 +60,7 @@
 					  Lisp_Object barg);
 void mswindows_unmodalize_signal_maybe (void);
 void mswindows_enqueue_dispatch_event (Lisp_Object event);
-
+void mswindows_enqueue_magic_event (HWND hwnd, UINT message);
 
 extern int mswindows_quit_chars_count;
 
--- a/src/free-hook.c	Mon Aug 13 10:13:49 2007 +0200
+++ b/src/free-hook.c	Mon Aug 13 10:14:14 2007 +0200
@@ -222,6 +222,7 @@
 					       (void **) &size);
 
       if (!present)
+	{
 	/* This can only happen if you try to free something that didn't
 	   come from malloc */
 	if (strict_free_check)
@@ -232,8 +233,10 @@
 	    __malloc_hook = check_malloc;
 	    goto end;
 	  }
+	}
 
       if (size < 0)
+	{
 	/* This happens when you free twice */
 	if (strict_free_check)
 	  abort ();
@@ -243,6 +246,7 @@
 	    __malloc_hook = check_malloc;
 	    goto end;
 	  }
+	}
       puthash (ptr, (void *)-size, pointer_table);
 #ifdef UNMAPPED_FREE
       /* Round up size to an even number of pages. */
--- a/src/linuxplay.c	Mon Aug 13 10:13:49 2007 +0200
+++ b/src/linuxplay.c	Mon Aug 13 10:14:14 2007 +0200
@@ -962,7 +962,7 @@
 
   /* We need to read at least the header information before we can start
      doing anything */
-  if (!data || length < HEADERSZ)
+  if (!data || length < HEADERSZ) {
     if (fd < 0) return;
     else {
       length = read(fd,linuxplay_sndbuf,SNDBUFSZ);
@@ -970,6 +970,7 @@
 	return;
       data   = linuxplay_sndbuf;
       length = SNDBUFSZ; }
+  }
 
   ffmt = analyze_format(data,&fmt,&speed,&tracks,&parsesndfile);
 
--- a/src/lread.c	Mon Aug 13 10:13:49 2007 +0200
+++ b/src/lread.c	Mon Aug 13 10:14:14 2007 +0200
@@ -1209,9 +1209,11 @@
   REGISTER Lisp_Object tem, tem2;
   int foundit;
 
+#if !defined(LOADHIST_DUMPED)
   /* Don't bother recording anything for preloaded files.  */
   if (purify_flag)
     return;
+#endif
 
   tail = Vload_history;
   prev = Qnil;
--- a/src/menubar-msw.c	Mon Aug 13 10:13:49 2007 +0200
+++ b/src/menubar-msw.c	Mon Aug 13 10:14:14 2007 +0200
@@ -96,12 +96,11 @@
 #define EMPTY_ITEM_ID ((UINT)LISP_TO_VOID (Qunbound))
 #define EMPTY_ITEM_NAME "(empty)"
 
-/* Qnil when there's no popup being tracked, or a descriptor
-   for the popup. gcpro'ed */
-static Lisp_Object current_tracking_popup;
+/* Current menu (bar or popup) descriptor. gcpro'ed */
+static Lisp_Object current_menudesc;
 
-/* Current popup has table. Qnil when no popup. gcpro'ed */
-static Lisp_Object current_popup_hash_table;
+/* Current menubar or popup hashtable. gcpro'ed */
+static Lisp_Object current_hashtable;
 
 /* Bound by menubar.el */
 static Lisp_Object Qfind_menu_item;
@@ -166,7 +165,7 @@
   *plist = Qnil;
 
   if (length < 3)
-    signal_simple_error ("button descriptors must be at least 3 long", desc);
+    signal_simple_error ("Button descriptors must be at least 3 long", desc);
 
   /* length 3:		[ "name" callback active-p ]
      length 4:		[ "name" callback active-p suffix ]
@@ -191,7 +190,7 @@
       int i;
       if (length & 1)
 	signal_simple_error (
-		"button descriptor has an odd number of keywords and values",
+		"Button descriptor has an odd number of keywords and values",
 			     desc);
 
       for (i = 2; i < length;)
@@ -199,7 +198,7 @@
 	  Lisp_Object key = contents [i++];
 	  Lisp_Object val = contents [i++];
 	  if (!KEYWORDP (key))
-	    signal_simple_error_2 ("not a keyword", key, desc);
+	    signal_simple_error_2 ("Not a keyword", key, desc);
 	  internal_plist_put (plist, key, val);
 	}
     }    
@@ -447,6 +446,44 @@
     AppendMenu (menu, MF_STRING | MF_GRAYED, EMPTY_ITEM_ID, EMPTY_ITEM_NAME);
 }
 
+/*
+ * The idea of checksumming is that we must hash minimal object
+ * which is neccessarily changes when the item changes. For separator
+ * this is a constant, for grey strings and submenus these are hashes
+ * of names, since sumbenus are unpopulated until opened so always
+ * equal otherwise. For items, this is a full hash value of a callback,
+ * because a callback may me a form which can be changed only somewhere
+ * in depth.
+ */
+static unsigned long
+checksum_menu_item (Lisp_Object item)
+{
+  if (STRINGP (item))
+    {
+      /* Separator or unselectable text - hash as a string + 13 */
+      if (separator_string_p (XSTRING_DATA (item)))
+	return 13;
+      else
+	return internal_hash (item, 0) + 13;
+    }
+  else if (CONSP (item))
+    {
+      /* Submenu - hash by its string name + 0 */
+      return internal_hash (XCAR(item), 0);
+    }
+  else if (VECTORP (item))
+    {
+      /* An ordinary item - hash its name and callback form. */
+      Lisp_Object plist, name, callback;
+      gui_parse_button_descriptor (item, &name, &callback, &plist);
+      return HASH2 (internal_hash (name, 0),
+		    internal_hash (callback, 0));
+    }
+ 
+  /* An error - will be caught later */
+  return 0;
+}
+
 static void
 populate_menu_add_item (HMENU menu, Lisp_Object path,
 			Lisp_Object hash_tab, Lisp_Object item, int flush_right)
@@ -480,7 +517,7 @@
       HMENU submenu;
 	
       if (!STRINGP (subname))
-	signal_simple_error ("menu name (first element) must be a string", item);
+	signal_simple_error ("Menu name (first element) must be a string", item);
 
       item = gui_parse_menu_keywords (XCDR (item), &plist);
       GCPRO1 (plist);
@@ -557,7 +594,7 @@
     }
   else
     {
-      signal_simple_error ("ill-constructed menu descriptor", item);
+      signal_simple_error ("Ill-constructed menu descriptor", item);
     }
 
   if (flush_right)
@@ -566,16 +603,29 @@
   InsertMenuItem (menu, UINT_MAX, TRUE, &item_info);
 }  
 
-static void
-populate_menu (HMENU menu, Lisp_Object path, Lisp_Object descriptor,
-	       Lisp_Object hash_tab, int bar_p)
+/*
+ * This function is called from populate_menu and checksum_menu.
+ * When called to populate, MENU is a menu handle, PATH is a
+ * list of strings representing menu path from root to this submenu,
+ * DESCRIPTOR is a menu descriptor, HASH_TAB is a hashtable associated
+ * with root menu, BAR_P indicates whether this called for a menubar or
+ * a popup, and POPULATE_P is non-zero. Return value must be ignored.
+ * When called to checksum, DESCRIPTOR has the same meaning, POPULATE_P
+ * is zero, PATH must be Qnil, and the rest of parameters is ignored.
+ * Return value is the menu checksum.
+ */
+static unsigned long
+populate_or_checksum_helper (HMENU menu, Lisp_Object path, Lisp_Object descriptor,
+			     Lisp_Object hash_tab, int bar_p, int populate_p)
 {
   Lisp_Object menu_name, plist, item_desc;
   int deep_p, flush_right;
   struct gcpro gcpro1;
+  unsigned long checksum = 0;
 
   /* Will initially contain only "(empty)" */
-  empty_menu (menu, 1);
+  if (populate_p)
+    empty_menu (menu, 1);
 
   /* PATH set to nil indicates top-level popup or menubar */
   deep_p = !NILP (path);
@@ -584,7 +634,7 @@
     top_level_menu = menu;
 
   if (!CONSP(descriptor))
-    signal_simple_error ("menu descriptor must be a list", descriptor);
+    signal_simple_error ("Menu descriptor must be a list", descriptor);
 
   if (STRINGP (XCAR (descriptor)))
     {
@@ -595,7 +645,7 @@
     {
       menu_name = Qnil;
       if (deep_p) /* Not a popup or bar */
-	signal_simple_error ("menu must have a name", descriptor);
+	signal_simple_error ("Menu must have a name", descriptor);
     }
 
   /* Fetch keywords prepending the item list */
@@ -612,26 +662,48 @@
 	{
 	  if (bar_p)
 	    flush_right = 1;
+	  if (!populate_p)
+	    checksum = HASH2 (checksum, Qnil);
 	}
-      else
+      else if (populate_p)
 	populate_menu_add_item (menu, path, hash_tab,
 				XCAR (item_desc), flush_right);
+      else
+	checksum = HASH2 (checksum,
+			  checksum_menu_item (XCAR (item_desc)));
     }
   
-  /* Remove the "(empty)" item, if there are other ones */
-  if (GetMenuItemCount (menu) > 1)
-    RemoveMenu (menu, EMPTY_ITEM_ID, MF_BYCOMMAND);
+  if (populate_p)
+    {
+      /* Remove the "(empty)" item, if there are other ones */
+      if (GetMenuItemCount (menu) > 1)
+	RemoveMenu (menu, EMPTY_ITEM_ID, MF_BYCOMMAND);
 
-  /* Add the header to the popup, if told so. The same as in X - an
-     insensitive item, and a separator (Seems to me, there were
-     two separators in X... In Windows this looks ugly, anywats. */
-  if (!bar_p && !deep_p && popup_menu_titles && !NILP(menu_name))
-    {
-      InsertMenu (menu, 0, MF_BYPOSITION | MF_STRING | MF_DISABLED,
-		  0, XSTRING_DATA(menu_name));
-      InsertMenu (menu, 1, MF_BYPOSITION | MF_SEPARATOR, 0, NULL);
-      SetMenuDefaultItem (menu, 0, MF_BYPOSITION);
+      /* Add the header to the popup, if told so. The same as in X - an
+	 insensitive item, and a separator (Seems to me, there were
+	 two separators in X... In Windows this looks ugly, anywats. */
+      if (!bar_p && !deep_p && popup_menu_titles && !NILP(menu_name))
+	{
+	  InsertMenu (menu, 0, MF_BYPOSITION | MF_STRING | MF_DISABLED,
+		      0, XSTRING_DATA(menu_name));
+	  InsertMenu (menu, 1, MF_BYPOSITION | MF_SEPARATOR, 0, NULL);
+	  SetMenuDefaultItem (menu, 0, MF_BYPOSITION);
+	}
     }
+  return checksum;
+}
+
+static void
+populate_menu (HMENU menu, Lisp_Object path, Lisp_Object descriptor,
+			     Lisp_Object hash_tab, int bar_p)
+{
+  populate_or_checksum_helper (menu, path, descriptor, hash_tab, bar_p, 1);
+}
+
+static unsigned long
+checksum_menu (Lisp_Object descriptor)
+{
+  return populate_or_checksum_helper (NULL, Qnil, descriptor, Qunbound, 0, 0);
 }
 
 static Lisp_Object
@@ -666,6 +738,7 @@
     {
       /* Menubar has gone */
       FRAME_MSWINDOWS_MENU_HASHTABLE(f) = Qnil;
+      SetMenu (FRAME_MSWINDOWS_HANDLE (f), NULL);
       DestroyMenu (menubar);
       DrawMenuBar (FRAME_MSWINDOWS_HANDLE (f));
       return;
@@ -684,12 +757,9 @@
       return;
     }
 
-  /* Now we have to check if the menubar has really changed */
-  /* #### For now we do not though */
-
-  /* We cannot re-create the menu, cause WM_INITMENU does not like that.
-     We'll clear it instead. */
-  empty_menu (menubar, 0);
+  /* Now we bail out if the menubar has not changed */
+  if (FRAME_MSWINDOWS_MENU_CHECKSUM(f) == checksum_menu (desc))
+    return;
 
 populate:
   /* Come with empty hash table */
@@ -704,6 +774,8 @@
 		 FRAME_MSWINDOWS_MENU_HASHTABLE(f), 1);
   SetMenu (FRAME_MSWINDOWS_HANDLE (f), menubar);
   DrawMenuBar (FRAME_MSWINDOWS_HANDLE (f));
+
+  FRAME_MSWINDOWS_MENU_CHECKSUM(f) = checksum_menu (desc);
 }
 
 static void
@@ -715,8 +787,8 @@
     return;
 
   /* #### If a filter function has set desc to Qnil, this abort()
-     triggers. To resolve, we must prevent explicitely filters from
-     mangling with te active menu. In apply_filter probably?
+     triggers. To resolve, we must prevent filters explicitely from
+     mangling with the active menu. In apply_filter probably?
      Is copy-tree on the whole menu too expensive? */
   if (NILP(desc))
     /* abort(); */
@@ -742,13 +814,9 @@
 menu_cleanup (struct frame *f)
 {
   /* This function can GC */
-  if (!NILP (current_tracking_popup))
-    {
-      current_tracking_popup = Qnil;
-      current_popup_hash_table = Qnil;
-    }
-  else
-    prune_menubar (f);
+  current_menudesc = Qnil;
+  current_hashtable = Qnil;
+  prune_menubar (f);
 }
   
 
@@ -761,37 +829,32 @@
   /* This function can call lisp, beat dogs and stick chewing gum to
      everything! */
 
-  Lisp_Object path, desc, hash_tab;
+  Lisp_Object path, desc;
   struct gcpro gcpro1;
 
-  if (!NILP (current_tracking_popup))
-    {
-      desc = current_tracking_popup;
-      hash_tab = current_popup_hash_table;
-    }
-  else
-    {
-      desc = current_frame_menubar (f);
-      hash_tab = FRAME_MSWINDOWS_MENU_HASHTABLE(f);
-    }
-
   /* Find which guy is going to explode */
-  path = Fgethash (hmenu_to_lisp_object (menu), hash_tab, Qunbound);
+  path = Fgethash (hmenu_to_lisp_object (menu), current_hashtable, Qunbound);
   assert (!UNBOUNDP (path));
+#ifdef DEBUG_XEMACS
+  /* Allow to continue in a debugger after assert - not so fatal */
+  if (UNBOUNDP (path))
+    error ("internal menu error");
+#endif
 
   /* Now find a desc chunk for it. If none, then probably menu open
      hook has played too much games around stuff */
+  desc = current_menudesc;
   if (!NILP (path))
     {
       desc = find_menu (desc, path);
       if (NILP (desc))
-	signal_simple_error ("this menu does not exist any more", path);
+	signal_simple_error ("This menu does not exist any more", path);
     }
 
   /* Now, stuff it */
   /* DESC may be generated by filter, so we have to gcpro it */
   GCPRO1 (desc);
-  populate_menu (menu, path, desc, hash_tab, 0);
+  populate_menu (menu, path, desc, current_hashtable, 0);
   UNGCPRO;
   return Qt;
 }
@@ -806,12 +869,16 @@
   /* We simply ignore return value. In any case, we construct the bar
      on the fly */
   run_hook (Vactivate_menubar_hook);
-  
+
   update_frame_menubar_maybe (f);
+
+  current_menudesc = current_frame_menubar (f);
+  current_hashtable = FRAME_MSWINDOWS_MENU_HASHTABLE(f);
+  assert (HASHTABLEP (current_hashtable));
+
   return Qt;
 }
 
-
 #ifdef KKM_DOES_NOT_LIKE_UNDOCS_SOMETIMES
 
 /* #### This may become wrong in future Windows */
@@ -836,15 +903,10 @@
 mswindows_handle_wm_command (struct frame* f, WORD id)
 {
   /* Try to map the command id through the proper hash table */
-  Lisp_Object hash_tab, command, funcsym, frame;
+  Lisp_Object command, funcsym, frame;
   struct gcpro gcpro1;
 
-  if (!NILP (current_tracking_popup))
-    hash_tab = current_popup_hash_table;
-  else
-    hash_tab = FRAME_MSWINDOWS_MENU_HASHTABLE(f);
-
-  command = Fgethash (make_int (id), hash_tab, Qunbound);
+  command = Fgethash (make_int (id), current_hashtable, Qunbound);
   if (UNBOUNDP (command))
     {
       menu_cleanup (f);
@@ -858,23 +920,21 @@
   menu_cleanup (f);
 
   /* Ok, this is our one. Enqueue it. */
-#if 0
-  if (SYMBOLP (command))
-    Fcall_interactively (command, Qnil, Qnil);
-  else if (CONSP (command))
-    Feval (command);
-  else
-    signal_simple_error ("illegal callback", command);
-#endif
   if (SYMBOLP (command))
       funcsym = Qcall_interactively;
   else if (CONSP (command))
       funcsym = Qeval;
   else
-    signal_simple_error ("illegal callback", command);
+    signal_simple_error ("Illegal callback", command);
 
   XSETFRAME (frame, f);
   enqueue_misc_user_event (frame, funcsym, command);
+
+  /* Needs good bump also, for WM_COMMAND may have been dispatched from
+     mswindows_need_event, which will block again despite new command
+     event has arrived */
+  mswindows_enqueue_magic_event (FRAME_MSWINDOWS_HANDLE(f),
+				 XM_BUMPQUEUE);
   
   UNGCPRO; /* command */
   return Qt;
@@ -918,10 +978,15 @@
 }
 
 Lisp_Object
-mswindows_handle_wm_initmenu (struct frame* f)
+mswindows_handle_wm_initmenu (HMENU hmenu, struct frame* f)
 {
-  wm_initmenu_frame = f;
-  return mswindows_protect_modal_loop (unsafe_handle_wm_initmenu, Qnil);
+  /* Handle only frame menubar, ignore if from popup or system menu */
+  if (GetMenu (FRAME_MSWINDOWS_HANDLE(f)) == hmenu)
+    {
+      wm_initmenu_frame = f;
+      return mswindows_protect_modal_loop (unsafe_handle_wm_initmenu, Qnil);
+    }
+  return Qt;
 }
 
 Lisp_Object
@@ -992,12 +1057,13 @@
   if (SYMBOLP (menu_desc))
     menu_desc = Fsymbol_value (menu_desc);
 
-  current_tracking_popup = menu_desc;
-  current_popup_hash_table = Fmake_hashtable (make_int(10), Qequal);
+  current_menudesc = menu_desc;
+  current_hashtable = Fmake_hashtable (make_int(10), Qequal);
   menu = create_empty_popup_menu();
-  Fputhash (hmenu_to_lisp_object (menu), Qnil, current_popup_hash_table);
+  Fputhash (hmenu_to_lisp_object (menu), Qnil, current_hashtable);
   
-  ok = TrackPopupMenu (menu, TPM_LEFTALIGN | TPM_LEFTBUTTON,
+  ok = TrackPopupMenu (menu,
+		       TPM_LEFTALIGN | TPM_LEFTBUTTON | TPM_RIGHTBUTTON,
 		       pt.x, pt.y, 0,
 		       FRAME_MSWINDOWS_HANDLE (f), NULL);
 
@@ -1009,7 +1075,7 @@
   /* This is probably the only real reason for failure */
   if (!ok) {
     menu_cleanup (f);
-    signal_simple_error ("cannot track popup menu while in menu",
+    signal_simple_error ("Cannot track popup menu while in menu",
 			 menu_desc);
   }
 }
@@ -1035,11 +1101,11 @@
 void
 vars_of_menubar_mswindows (void)
 {
-  current_tracking_popup = Qnil;
-  current_popup_hash_table = Qnil;
+  current_menudesc = Qnil;
+  current_hashtable = Qnil;
 
-  staticpro (&current_tracking_popup);
-  staticpro (&current_popup_hash_table);
+  staticpro (&current_menudesc);
+  staticpro (&current_hashtable);
 
   Fprovide (intern ("mswindows-menubars"));
 }
--- a/src/menubar-msw.h	Mon Aug 13 10:13:49 2007 +0200
+++ b/src/menubar-msw.h	Mon Aug 13 10:14:14 2007 +0200
@@ -34,7 +34,7 @@
 
 /* Message handlers. Called from window procedure */
 Lisp_Object mswindows_handle_wm_initmenupopup (HMENU hmenu, struct frame* frm);
-Lisp_Object mswindows_handle_wm_initmenu (struct frame* f);
+Lisp_Object mswindows_handle_wm_initmenu (HMENU hmenu, struct frame* f);
 Lisp_Object mswindows_handle_wm_exitmenuloop (struct frame* f);
 Lisp_Object mswindows_handle_wm_command (struct frame* f, WORD command);
 
--- a/src/msw-proc.c	Mon Aug 13 10:13:49 2007 +0200
+++ b/src/msw-proc.c	Mon Aug 13 10:14:14 2007 +0200
@@ -81,7 +81,7 @@
 /* Enqueue helpers                                                            */
 /*----------------------------------------------------------------------------*/
 
-static void
+void
 mswindows_enqueue_magic_event (HWND hwnd, UINT message)
 {
   Lisp_Object emacs_event = Fmake_event (Qnil, Qnil);
@@ -627,6 +627,7 @@
 #ifdef HAVE_MENUBARS
   case WM_INITMENU:
     if (UNBOUNDP (mswindows_handle_wm_initmenu (
+			(HMENU) wParam,
 			XFRAME (mswindows_find_frame (hwnd)))))
       SendMessage (hwnd, WM_CANCELMODE, 0, 0);
     break;
--- a/src/print.c	Mon Aug 13 10:13:49 2007 +0200
+++ b/src/print.c	Mon Aug 13 10:14:14 2007 +0200
@@ -1602,7 +1602,11 @@
 	}
       if (COMPILED_FUNCTIONP (*bt->function))
 	{
+#if defined(COMPILED_FUNCTION_ANNOTATION_HACK)
 	  Lisp_Object ann = Fcompiled_function_annotation (*bt->function);
+#else
+	  Lisp_Object ann = Qnil;
+#endif
 	  if (!NILP (ann))
 	    {
 	      stderr_out ("<compiled-function from ");
--- a/src/process.c	Mon Aug 13 10:13:49 2007 +0200
+++ b/src/process.c	Mon Aug 13 10:14:14 2007 +0200
@@ -1887,11 +1887,12 @@
 set_process_filter (Lisp_Object proc, Lisp_Object filter, int filter_does_read)
 {
   CHECK_PROCESS (proc);
-  if (PROCESS_LIVE_P (proc))
+  if (PROCESS_LIVE_P (proc)) {
     if (EQ (filter, Qt))
       event_stream_unselect_process (XPROCESS (proc));
     else
       event_stream_select_process (XPROCESS (proc));
+  }
 
   XPROCESS (proc)->filter = filter;
   XPROCESS (proc)->filter_does_read = filter_does_read;
--- a/src/regex.c	Mon Aug 13 10:13:49 2007 +0200
+++ b/src/regex.c	Mon Aug 13 10:14:14 2007 +0200
@@ -2636,11 +2636,12 @@
             case ')':
               if (syntax & RE_NO_BK_PARENS) goto normal_backslash;
 
-              if (COMPILE_STACK_EMPTY)
+              if (COMPILE_STACK_EMPTY) {
                 if (syntax & RE_UNMATCHED_RIGHT_PAREN_ORD)
                   goto normal_backslash;
                 else
                   FREE_STACK_RETURN (REG_ERPAREN);
+	      }
 
             handle_close:
               if (fixup_alt_jump)
@@ -2656,11 +2657,12 @@
                 }
 
               /* See similar code for backslashed left paren above.  */
-              if (COMPILE_STACK_EMPTY)
+              if (COMPILE_STACK_EMPTY) {
                 if (syntax & RE_UNMATCHED_RIGHT_PAREN_ORD)
                   goto normal_char;
                 else
                   FREE_STACK_RETURN (REG_ERPAREN);
+	      }
 
               /* Since we just checked for an empty stack above, this
                  ``can't happen''.  */
--- a/src/sound.c	Mon Aug 13 10:13:49 2007 +0200
+++ b/src/sound.c	Mon Aug 13 10:14:14 2007 +0200
@@ -90,10 +90,12 @@
   GCPRO1 (file);
   file = Fexpand_file_name (file, Qnil);
   if (NILP (Ffile_readable_p (file)))
+    {
     if (NILP (Ffile_exists_p (file)))
       error ("file does not exist.");
     else
       error ("file is unreadable.");
+    }
   UNGCPRO;
 
 #ifdef HAVE_NAS_SOUND
--- a/version.sh	Mon Aug 13 10:13:49 2007 +0200
+++ b/version.sh	Mon Aug 13 10:14:14 2007 +0200
@@ -1,5 +1,5 @@
 #!/bin/sh
 emacs_major_version=20
 emacs_minor_version=5
-emacs_beta_version=14
-xemacs_codename="Booted Goat"
+emacs_beta_version=15
+xemacs_codename="British Alpine"