xemacs-beta: lisp/simple.el comparison

comparison lisp/simple.el @ 793:e38acbeb1cae

[xemacs-hg @ 2002-03-29 04:46:17 by ben] lots o' fixes etc/ChangeLog: New file. Separated out all entries for etc/ into their own ChangeLog. Includes entries for the following files: etc/BABYL, etc/BETA, etc/CHARSETS, etc/DISTRIB, etc/Emacs.ad, etc/FTP, etc/GNUS-NEWS, etc/GOATS, etc/HELLO, etc/INSTALL, etc/MACHINES, etc/MAILINGLISTS, etc/MSDOS, etc/MYTHOLOGY, etc/NEWS, etc/OXYMORONS, etc/PACKAGES, etc/README, etc/TUTORIAL, etc/TUTORIAL.de, etc/TUTORIAL.ja, etc/TUTORIAL.ko, etc/TUTORIAL.se, etc/aliases.ksh, etc/altrasoft-logo.xpm, etc/check_cygwin_setup.sh, etc/custom/example-themes/europe-theme.el, etc/custom/example-themes/ex-custom-file, etc/custom/example-themes/example-theme.el, etc/e/eterm.ti, etc/edt-user.doc, etc/enriched.doc, etc/etags.1, etc/gnuserv.1, etc/gnuserv.README, etc/package-index.LATEST.gpg, etc/package-index.LATEST.pgp, etc/photos/jan.png, etc/recycle.xpm, etc/refcard.tex, etc/sample.Xdefaults, etc/sample.emacs, etc/sgml/CATALOG, etc/sgml/HTML32.dtd, etc/skk/SKK.tut.E, etc/smilies/Face_ase.xbm, etc/smilies/Face_ase2.xbm, etc/smilies/Face_ase3.xbm, etc/smilies/Face_smile.xbm, etc/smilies/Face_weep.xbm, etc/sounds, etc/toolbar, etc/toolbar/workshop-cap-up.xpm, etc/xemacs-ja.1, etc/xemacs.1, etc/yow.lines, etc\BETA, etc\NEWS, etc\README, etc\TUTORIAL, etc\TUTORIAL.de, etc\check_cygwin_setup.sh, etc\sample.init.el, etc\unicode\README, etc\unicode\mule-ucs\*, etc\unicode\other\* unicode/unicode-consortium/8859-16.TXT: New file. mule/english.el: Define this charset now, since a bug was fixed that formerly prevented it. mule/ethio-util.el: Fix compile errors involving Unicode `characters', which should be integers. Makefile.in.in: Always include gui.c, to fix compile error when TTY-only. EmacsFrame.c, abbrev.c, alloc.c, buffer.c, buffer.h, bytecode.c, bytecode.h, callint.c, callproc.c, casetab.c, casetab.h, charset.h, chartab.c, chartab.h, cmds.c, console-msw.c, console-msw.h, console-tty.c, console-x.c, console-x.h, console.c, console.h, data.c, database.c, device-gtk.c, device-msw.c, device-x.c, device.c, device.h, dialog-msw.c, doc.c, doprnt.c, dumper.c, dynarr.c, editfns.c, eldap.c, eldap.h, elhash.c, elhash.h, emacs.c, eval.c, event-Xt.c, event-gtk.c, event-msw.c, event-stream.c, event-tty.c, event-unixoid.c, events.c, events.h, extents.c, extents.h, faces.c, faces.h, file-coding.c, file-coding.h, fileio.c, filelock.c, fns.c, frame-gtk.c, frame-msw.c, frame-tty.c, frame-x.c, frame.c, frame.h, free-hook.c, general-slots.h, glyphs-eimage.c, glyphs-gtk.c, glyphs-msw.c, glyphs-widget.c, glyphs-x.c, glyphs.c, glyphs.h, gpmevent.c, gtk-xemacs.c, gui-msw.c, gui-x.c, gui-x.h, gui.c, gui.h, gutter.c, gutter.h, indent.c, input-method-xlib.c, insdel.c, keymap.c, keymap.h, lisp-disunion.h, lisp-union.h, lisp.h, lread.c, lrecord.h, lstream.c, lstream.h, marker.c, menubar-gtk.c, menubar-msw.c, menubar-x.c, menubar.c, minibuf.c, mule-canna.c, mule-ccl.c, mule-charset.c, mule-wnnfns.c, native-gtk-toolbar.c, objects-msw.c, objects-tty.c, objects-x.c, objects.c, objects.h, opaque.c, opaque.h, postgresql.c, postgresql.h, print.c, process-unix.c, process.c, process.h, rangetab.c, rangetab.h, redisplay-gtk.c, redisplay-msw.c, redisplay-output.c, redisplay-tty.c, redisplay-x.c, redisplay.c, scrollbar-gtk.c, scrollbar-msw.c, scrollbar-x.c, scrollbar.c, scrollbar.h, search.c, select-gtk.c, select-x.c, sound.c, specifier.c, specifier.h, strftime.c, symbols.c, symeval.h, syntax.h, text.c, text.h, toolbar-common.c, toolbar-msw.c, toolbar.c, toolbar.h, tooltalk.c, tooltalk.h, ui-gtk.c, ui-gtk.h, undo.c, vm-limit.c, window.c, window.h: Eliminate XSETFOO. Replace all usages with wrap_foo(). Make symbol->name a Lisp_Object, not Lisp_String *. Eliminate nearly all uses of Lisp_String * in favor of Lisp_Object, and correct macros so most of them favor Lisp_Object. Create new error-behavior ERROR_ME_DEBUG_WARN -- output warnings, but at level `debug' (usually ignored). Use it when instantiating specifiers, so problems can be debugged. Move log-warning-minimum-level into C so that we can optimize ERROR_ME_DEBUG_WARN. Fix warning levels consistent with new definitions. Add default_ and parent fields to char table; not yet implemented. New fun Dynarr_verify(); use for further error checking on Dynarrs. Rearrange code at top of lisp.h in conjunction with dynarr changes. Fix eifree(). Use Eistrings in various places (format_event_object(), where_is_to_char(), and callers thereof) to avoid fixed-size strings buffers. New fun write_eistring(). Reindent and fix GPM code to follow standards. Set default MS Windows font to Lucida Console (same size as Courier New but less interline spacing, so more lines fit). Increase default frame size on Windows to 50 lines. (If that's too big for the workspace, the frame will be shrunk as necessary.) Fix problem with text files with no newlines (). (Change `convert-eol' coding system to use `nil' for autodetect, consistent with make-coding-system.) Correct compile warnings in vm-limit.c. Fix handling of reverse-direction charsets to avoid errors when opening (e.g.) mule-ucs/lisp/reldata/uiso8859-6.el. Recode some object printing methods to use write_fmt_string() instead of a fixed buffer and sprintf. Turn on display of png comments as warnings (level `info'), now that they're unobtrusive. Revamped the sound documentation. Fixed bug in redisplay w.r.t. hscroll/truncation/continuation glyphs causing jumping up and down of the lines, since they're bigger than the line size. (It was seen most obviously when there's a horizontal scroll bar, e.g. do C-h a glyph or something like that.) The problem was that the glyph-contrib-p setting on glyphs was ignored even if it was set properly, which it wasn't until now.

author	ben
date	Fri, 29 Mar 2002 04:49:13 +0000
parents	79940b592197
children	2b676dc88c66

comparison

equal deleted inserted replaced

-:4e83fdb13eb9
+:e38acbeb1cae
 ;;Subsumed by view-lossage
 ;; Not really, I'm adding it back by popular demand. -slb
 (defun show-message-log ()
 "Show the \" *Message-Log*\" buffer, which contains old messages and errors."
 (interactive)
-(pop-to-buffer (get-buffer-create " *Message-Log*")))
+(view-lossage t))
 (defvar log-message-filter-function 'log-message-filter
 "Value must be a function of two arguments: a symbol (label) and
 a string (message).  It should return non-nil to indicate a message
 should be logged.  Possible values include 'log-message-filter and
 (goto-char (point-max))
 ;(insert (concat (upcase (symbol-name label)) ": "  message "\n"))
 (let (extent)
 	;; Mark multiline message with an extent, which `view-lossage'
 	;; will recognize.
-	(when (string-match "\n" message)
+	(save-match-data
-	  (setq extent (make-extent (point) (point)))
+	  (when (string-match "\n" message)
-	  (set-extent-properties extent '(end-open nil message-multiline t)))
+	    (setq extent (make-extent (point) (point)))
+	    (set-extent-properties extent '(end-open nil message-multiline t)))
+	  )
 	(insert message "\n")
 	(when extent
 	  (set-extent-property extent 'end-open t)))
 (when (> (point-max) (max log-message-max-size (point-min)))
 	;; Trim log to ~90% of max size.
 		(push msg log)
 		(setcdr s (cdr (cdr s))))
 	    (setq s (cdr s))))))
 ;; (possibly) log each removed message
 (while log
-(condition-case e
+(with-trapping-errors
-	  (run-hook-with-args 'remove-message-hook
+	:operation 'remove-message-hook
-			      (car (car log)) (cdr (car log)))
+	:class 'message-log
-	(error (setq remove-message-hook nil)
+	:error-form (progn
-	       (lwarn 'message-log 'warning
+		      (setq remove-message-hook nil)
-		 "Error caught in `remove-message-hook': %s"
+		      (let ((inhibit-read-only t))
-		 (error-message-string e))
+			(erase-buffer " *Echo Area*")))
-	       (let ((inhibit-read-only t))
+	:resignal t
-		 (erase-buffer " *Echo Area*"))
+	(run-hook-with-args 'remove-message-hook
-	       (signal (car e) (cdr e))))
+			    (car (car log)) (cdr (car log))))
 (setq log (cdr log)))))
 (defun append-message (label message &optional frame stdout-p)
 (or frame (setq frame (selected-frame)))
 ;; Add a new entry to the message-stack, or modify an existing one
 "Minimum level of warnings that should be logged.
 The warnings in levels below this are completely ignored, as if they never
 happened.
 The recognized warning levels, in decreasing order of priority, are
-'emergency, 'alert, 'critical, 'error, 'warning, 'notice, 'info, and
+'emergency, 'critical, 'error, 'warning, 'alert, 'notice, 'info, and
 'debug.
 See also `display-warning-minimum-level'.
 You can also control which warnings are displayed on a class-by-class
 basis.  See `display-warning-suppressed-classes' and
-`log-warning-suppressed-classes'."
+`log-warning-suppressed-classes'.
-:type '(choice (const emergency) (const alert) (const critical)
-		 (const error) (const warning) (const notice)
+For a description of the meaning of the levels, see `display-warning.'"
+:type '(choice (const emergency) (const critical)
+		 (const error) (const warning) (const alert) (const notice)
 		 (const info) (const debug))
 :group 'warnings)
-(defcustom display-warning-minimum-level 'info
+(defcustom display-warning-minimum-level 'warning
-"Minimum level of warnings that should be displayed.
+"Minimum level of warnings that cause the warnings buffer to be displayed.
-The warnings in levels below this will be generated, but not
+Warnings at this level or higher will force the *Warnings* buffer, in which
-displayed.
+the warnings are logged, to be displayed.  The warnings in levels below
+this, but at least as high as `log-warning-suppressed-classes', will be
+shown in the minibuffer.
 The recognized warning levels, in decreasing order of priority, are
-'emergency, 'alert, 'critical, 'error, 'warning, 'notice, 'info, and
+'emergency, 'critical, 'error, 'warning, 'alert, 'notice, 'info, and
 'debug.
 See also `log-warning-minimum-level'.
 You can also control which warnings are displayed on a class-by-class
 basis.  See `display-warning-suppressed-classes' and
-`log-warning-suppressed-classes'."
+`log-warning-suppressed-classes'.
-:type '(choice (const emergency) (const alert) (const critical)
-		 (const error) (const warning) (const notice)
+For a description of the meaning of the levels, see `display-warning.'"
+:type '(choice (const emergency) (const critical)
+		 (const error) (const warning) (const alert) (const notice)
 		 (const info) (const debug))
 :group 'warnings)
 (defvar log-warning-suppressed-classes nil
 "List of classes of warnings that shouldn't be logged or displayed.
 (defvar warning-count 0
 "Count of the number of warning messages displayed so far.")
 (defconst warning-level-alist '((emergency . 8)
-				(alert . 7)
+				(critical . 7)
-				(critical . 6)
+				(error . 6)
-				(error . 5)
+				(warning . 5)
-				(warning . 4)
+				(alert . 4)
 				(notice . 3)
 				(info . 2)
 				(debug . 1)))
 (defun warning-level-p (level)
 "Non-nil if LEVEL specifies a warning level."
 (and (symbolp level) (assq level warning-level-alist)))
+(defun warning-level-< (level1 level2)
+"Non-nil if warning level LEVEL1 is lower than LEVEL2."
+(check-argument-type 'warning-level-p level1)
+(check-argument-type 'warning-level-p level2)
+(< (cdr (assq level1 warning-level-alist))
+(cdr (assq level2 warning-level-alist))))
 ;; If you're interested in rewriting this function, be aware that it
 ;; could be called at arbitrary points in a Lisp program (when a
 ;; built-in function wants to issue a warning, it will call out to
 ;; this function the next time some Lisp code is evaluated).  Therefore,
 (add-hook 'after-init-hook 'after-init-display-warnings)
 (defun display-warning (class message &optional level)
 "Display a warning message.
-CLASS should be a symbol describing what sort of warning this is, such
-as `resource' or `key-mapping'.  A list of such symbols is also
+\[This is the most basic entry point for displaying a warning.  In practice,
-accepted. (Individual classes can be suppressed; see
+`lwarn' or `warn' are probably more convenient for most usages.]
-`display-warning-suppressed-classes'.)  Optional argument LEVEL can
-be used to specify a priority for the warning, other than default priority
+CLASS should be a symbol describing what sort of warning this is, such as
-`warning'. (See `display-warning-minimum-level').  The message is
+`resource' or `key-mapping' -- this refers, more or less, to the module in
-inserted into the *Warnings* buffer, which is made visible at appropriate
+which the warning is generated and serves to group warnings together with
-times."
+similar semantics.  A list of such symbols is also accepted.
+Optional argument LEVEL can be used to specify a priority for the warning,
+other than default priority `warning'.  The currently defined levels are,
+from highest to lowest:
+Level        Meaning
+-----------------------------------------------------------------------------
+emergency    A fatal or near-fatal error.  XEmacs is likely to crash.
+critical     A serious, nonrecoverable problem has occurred -- e.g., the
+loss of a major subsystem, such as the crash of the X server
+	     when XEmacs is connected to the server.
+error        A warning about a problematic condition that should be fixed,
+and XEmacs cannot work around it -- it causes a failure of an
+	     operation. (In most circumstances, consider just signalling
+an error). However, there is no permanent damage and the
+situation is ultimately recoverable.
+warning      A warning about a problematic condition that should be fixed,
+but XEmacs can work around it.
+\[By default, warnings above here, as well as being logged, cause the
+*Warnings* buffer to be forcibly displayed, so that the warning (and
+previous warnings, since often a whole series of warnings are issued at
+once) can be examined in detail.  Also, the annoying presence of the
+*Warnings* buffer will encourage people to go out and fix the
+problem. Warnings below here are displayed in the minibuffer as well as
+logged in the *Warnings* buffer. but the *Warnings* buffer will not be
+forcibly shown, as these represent conditions the user is not expected to
+fix.]
+alert        A warning about a problematic condition that can't easily be
+fixed (often having to do with the external environment), and
+causes a failure.  We don't force the *Warnings* buffer to be
+	     displayed because the purpose of doing that is to force the
+user to fix the problem so that the buffer no longer appears.
+When the problem is outside the user's control, forcing the
+buffer is pointless and annoying.
+notice       A warning about a problematic condition that can't easily be
+fixed (often having to do with the external environment),
+but XEmacs can work around it.
+info         Random info about something new or unexpected that was noticed;
+does not generally indicate a problem.
+\[By default, warnings below here are ignored entirely.  All warnings above
+here are logged in the *Warnings* buffer.]
+debug        A debugging notice; normally, not seen at all.
+NOTE: `specifier-instance' outputs warnings at level `debug' when errors occur
+in the process of trying to instantiate a particular instantiator.  If you
+want to see these, change `log-warning-minimum-level'.
+There are two sets of variables.  One controls the lower level (see the
+above diagram) -- i.e. ignored entirely.  One controls the upper level --
+whether the *Warnings* buffer is forcibly displayed.  In particular:
+`display-warning-minimum-level' sets the upper level (see above), and
+`log-warning-minimum-level' the lower level.
+Individual classes can be suppressed. `log-warning-suppressed-classes'
+specifies a list of classes where warnings on those classes will be treated
+as if their level is below `log-warning-minimum-level' (i.e. they will be
+ignored completely), regardless of their actual level.  Similarly,
+`display-warning-suppressed-classes' specifies a list of classes where
+warnings on those classes will be treated as if their level is below
+`display-warning-minimum-level', but above `log-warning-minimum-level' so
+long as they're not listed in that variable as well."
 (or level (setq level 'warning))
 (or (listp class) (setq class (list class)))
 (check-argument-type 'warning-level-p level)
 (if (and (not (featurep 'infodock))
 	   (not init-file-loaded))
 	    ;; to get the C code's attention.
 	    (incf display-warning-tick))
 	  (with-current-buffer buffer
 	    (goto-char (point-max))
 	    (incf warning-count)
-	    (princ (format "(%d) (%s/%s) "
+	    (let ((start (point)))
-			   warning-count
+	      (princ (format "(%d) (%s/%s) "
-			   (mapconcat 'symbol-name class ",")
+			     warning-count
-			   level)
+			     (mapconcat 'symbol-name class ",")
-		   buffer)
+			     level)
-	    (princ message buffer)
+		     buffer)
-	    (terpri buffer)
+	      (princ message buffer)
-	    (terpri buffer)))))))
+	      (terpri buffer)
+	      (terpri buffer)
+	      (let ((ex (make-extent start (point))))
+		(set-extent-properties ex
+				       `(warning t warning-count ,warning-count
+						 warning-class ,class
+						 warning-level ,level)))))
+	  (message "%s: %s" (capitalize (symbol-name level)) message))))))
 (defun warn (&rest args)
-"Display a warning message.
+"Display a formatted warning message at default class and level.
 The message is constructed by passing all args to `format'.  The message
 is placed in the *Warnings* buffer, which will be popped up at the next
-redisplay.  The class of the warning is `warning'.  See also
+redisplay.  The class of the warning is `general'; the level is `warning'.
-`display-warning'."
-(display-warning 'warning (apply 'format args)))
+See `display-warning' for more info."
+(display-warning 'default (apply 'format args)))
 (defun lwarn (class level &rest args)
-"Display a labeled warning message.
+"Display a formatted warning message at specified class and level.
-CLASS should be a symbol describing what sort of warning this is, such
+The message is constructed by passing all args to `format'.  The message
-as `resource' or `key-mapping'.  A list of such symbols is also
+is placed in the *Warnings* buffer, which will be popped up at the next
-accepted. (Individual classes can be suppressed; see
+redisplay.
-`display-warning-suppressed-classes'.)  If non-nil, LEVEL can be used
-to specify a priority for the warning, other than default priority
+See `display-warning' for more info."
-`warning'. (See `display-warning-minimum-level').  The message is
-inserted into the *Warnings* buffer, which is made visible at appropriate
-times.
-The rest of the arguments are passed to `format'."
 (display-warning class (apply 'format args)
 		   (or level 'warning)))
 (defvar warning-marker nil)
 "Return the printable name of this instance of Emacs."
 (cond ((featurep 'infodock) "InfoDock")
 	((featurep 'xemacs) "XEmacs")
 	(t "Emacs")))
-(defun debug-print (format &rest args)
+(defun debug-print-1 (&rest args)
+"Send a debugging-type string to standard output.
+If the first argument is a string, it is considered to be a format
+specifier if there are sufficient numbers of other args, and the string is
+formatted using (apply #'format args).  Otherwise, each argument is printed
+individually in a numbered list."
+(let ((standard-output 'external-debugging-output)
+	(fmt (condition-case nil
+		 (and (stringp (first args))
+		      (apply #'format args))
+	       (error nil))))
+(if fmt
+	(progn
+	  (prin1 (apply #'format args))
+	  (terpri))
+(princ "--> ")
+(let ((i 1))
+	(dolist (sgra args)
+	  (if (> i 1) (princ "  "))
+	  (princ (format "%d. " i))
+	  (prin1 sgra)
+	  (incf i))
+	(terpri)))))
+(defun debug-print (&rest args)
 "Send a string to the debugging output.
-The string is formatted using (apply #'format FORMAT ARGS)."
+If the first argument is a string, it is considered to be a format
-(princ (apply #'format format args) 'external-debugging-output))
+specifier if there are sufficient numbers of other args, and the string is
+formatted using (apply #'format args).  Otherwise, each argument is printed
+individually in a numbered list."
+(let ((standard-output 'external-debugging-output))
+(apply #'debug-print-1 args)))
+(defun debug-backtrace ()
+"Send a backtrace to the debugging output."
+(let ((standard-output 'external-debugging-output))
+(backtrace nil t)
+(terpri)))
 ;;; simple.el ends here

Mercurial > hg > xemacs-beta

comparison lisp/simple.el @ 793:e38acbeb1cae