Mercurial > hg > xemacs-beta
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 (¤t_tracking_popup); - staticpro (¤t_popup_hash_table); + staticpro (¤t_menudesc); + staticpro (¤t_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