Mercurial > hg > xemacs-beta

changeset 1275:57b76886836d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2003-02-08 02:29:52 by ben] fixes to hyper-apropos, menubar-items, text-props, update-elc, lread.c; see log msg in lisp/ChangeLog
author ben
date Sat, 08 Feb 2003 02:29:55 +0000
parents 2dcc22ec7640
children beb703ae34fd
files lisp/hyper-apropos.el lisp/menubar-items.el lisp/text-props.el lisp/update-elc.el src/lread.c
diffstat 5 files changed, 65 insertions(+), 52 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/hyper-apropos.el	Sat Feb 08 02:28:15 2003 +0000
+++ b/lisp/hyper-apropos.el	Sat Feb 08 02:29:55 2003 +0000
@@ -3,7 +3,7 @@
 ;; Copyright (C) 1997 Free Software Foundation, Inc.
 ;; Copyright (C) 1994, 1995 Tinker Systems and INS Engineering Corp.
 ;; Copyright (C) 1995 Sun Microsystems.
-;; Copyright (C) 1996 Ben Wing.
+;; Copyright (C) 1996, 2003 Ben Wing.
 
 ;; Author: Jonathan Stigelman <stig@xemacs.org>
 ;; Maintainer: XEmacs Development Team
@@ -296,10 +296,15 @@
 a = autoloaded, b = byte-compiled, i = internal, l = lambda, m = macro.\n\n"
 		   'hyper-apropos-documentation)
       (insert-face "Functions and Macros:\n\n" 'hyper-apropos-major-heading)
-      (hyper-apropos-grok-functions flist)
+      (hyper-apropos-grok-functions flist nil)
+      (insert-face "\n\nObsolete Functions and Macros:\n\n" 'hyper-apropos-major-heading)
+      (hyper-apropos-grok-functions flist t)
       (insert-face "\n\nVariables and Constants:\n\n"
 		   'hyper-apropos-major-heading)
-      (hyper-apropos-grok-variables vlist)
+      (hyper-apropos-grok-variables vlist nil)
+      (insert-face "\n\nObsolete Variables and Constants:\n\n"
+		   'hyper-apropos-major-heading)
+      (hyper-apropos-grok-variables vlist t)
       (goto-char (point-min))))
   (switch-to-buffer hyper-apropos-apropos-buf)
   (hyper-apropos-mode regexp))
@@ -312,57 +317,76 @@
   (message "Re-running apropos...")
   (hyper-apropos hyper-apropos-last-regexp nil))
 
-(defun hyper-apropos-grok-functions (fns)
-  (let (bind doc type)
-    (dolist (fn fns)
-      (setq bind (symbol-function fn)
-	    type (cond ((subrp bind) ?i)
+(defun hyper-apropos-grok-functions (fns obsolete-p)
+  (loop for fn in fns
+    if (eq (function-obsolete-p fn) obsolete-p) do
+    (let* ((bind (symbol-function fn))
+	   (type (cond ((subrp bind) ?i)
 		       ((compiled-function-p bind) ?b)
 		       ((consp bind) (or (cdr
 					  (assq (car bind) '((autoload . ?a)
 							     (lambda . ?l)
 							     (macro . ?m))))
 					 ??))
-		       (t ?\ )))
+		       (t ?\ ))))
       (insert type (if (commandp fn) "* " "  "))
       (let ((e (insert-face (format "%S" fn) 'hyper-apropos-hyperlink)))
 	(set-extent-property e 'mouse-face 'highlight))
       (insert-char ?\  (let ((l (- 30 (length (format "%S" fn)))))
 			 (if (natnump l) l 0)))
       (and hyper-apropos-show-brief-docs
-	   (setq doc
-	   ;; A symbol's function slot can point to an unbound symbol.
-	   ;; In that case, `documentation' will fail.
-		 (ignore-errors
-		   (documentation fn)))
-	   (if  (string-match
-		 "^([^\n\t )]+[\t ]*\\([^\n)]+\\)?)\\(:[\t ]*\\|\n?\\'\\)"
-		 doc)
-	       (setq doc (substring doc (match-end 0) (string-match "\n" doc)))
-	     t)
-	   (insert-face (if doc
-			    (concat " - "
-				    (substring doc 0 (string-match "\n" doc)))
-			  " Not documented.")
-			'hyper-apropos-documentation))
+	   (let ((doc
+		  (if (and obsolete-p
+			   (symbolp fn)
+			   (symbolp (symbol-function fn)))
+		      (function-obsoleteness-doc fn)
+		    ;; A symbol's function slot can point to an unbound symbol.
+		    ;; In that case, `documentation' will fail.
+		    (ignore-errors
+		      (documentation fn)))))
+	     (if (and
+		  doc
+		  (string-match
+		   "\\`([^\n\t )]+[\t ]*\\([^\n)]+\\)?)\\(:[\t ]*\\|\n?\\'\\)"
+		   doc))
+		 (setq doc (substring doc (match-end 0)
+				      (string-match "\n" doc))))
+	     ;; Skip errant newlines at beginning of doc
+	     (if (and doc
+		      (string-match "\\`\n+" doc))
+		 (setq doc (substring doc (match-end 0))))
+	     (insert-face (if doc
+			      (concat " - "
+				      (substring doc 0
+						 (string-match "\n" doc)))
+			    " - Not documented.")
+			  'hyper-apropos-documentation)))
       (insert ?\n))))
 
-(defun hyper-apropos-grok-variables (vars)
-  (let (doc userp)
-    (dolist (var vars)
-      (setq userp (user-variable-p var))
+(defun hyper-apropos-grok-variables (vars obsolete-p)
+  (loop for var in vars
+    if (eq (variable-obsolete-p var) obsolete-p) do
+    (let ((userp (user-variable-p var)))
       (insert (if userp " * " "   "))
       (let ((e (insert-face (format "%S" var) 'hyper-apropos-hyperlink)))
 	(set-extent-property e 'mouse-face 'highlight))
       (insert-char ?\  (let ((l (- 30 (length (format "%S" var)))))
 			 (if (natnump l) l 0)))
       (and hyper-apropos-show-brief-docs
-	   (setq doc (documentation-property var 'variable-documentation))
-	   (insert-face (if doc
-			    (concat " - " (substring doc (if userp 1 0)
-						     (string-match "\n" doc)))
-			  " - Not documented.")
-			'hyper-apropos-documentation))
+	   (let ((doc
+		  (if (and obsolete-p (variable-alias var))
+		      (variable-obsoleteness-doc var)
+		    (documentation-property var 'variable-documentation))))
+	     ;; Skip errant newlines at beginning of doc
+	     (if (and doc
+		      (string-match "\\`\n+" doc))
+		 (setq doc (substring doc (match-end 0))))
+	     (insert-face (if doc
+			      (concat " - " (substring
+					     doc (if userp 1 0)
+					     (string-match "\n" doc)))
+			    " - Not documented.")
+			  'hyper-apropos-documentation)))
       (insert ?\n))))
 
 ;; ---------------------------------------------------------------------- ;;
--- a/lisp/menubar-items.el	Sat Feb 08 02:28:15 2003 +0000
+++ b/lisp/menubar-items.el	Sat Feb 08 02:29:55 2003 +0000
@@ -3,7 +3,7 @@
 ;; Copyright (C) 1991-1995, 1997-1998 Free Software Foundation, Inc.
 ;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
 ;; Copyright (C) 1995 Sun Microsystems.
-;; Copyright (C) 1995, 1996, 2000, 2001, 2002 Ben Wing.
+;; Copyright (C) 1995, 1996, 2000, 2001, 2002, 2003 Ben Wing.
 ;; Copyright (C) 1997 MORIOKA Tomohiko.
 
 ;; Maintainer: XEmacs Development Team
@@ -1608,13 +1608,13 @@
       ["What's %_New in XEmacs" view-emacs-news]
       "-----"
       ("%_Info (Online Docs)"
-       ["Info Con%_tents" (Info-goto-node "(dir)")]
+       ["%_Info Contents" (Info-goto-node "(dir)")]
        "-----"
        ["XEmacs %_User's Manual" (Info-goto-node "(XEmacs)")]
        ["XEmacs %_Lisp Reference Manual" (Info-goto-node "(Lispref)")]
        ["All About %_Packages" (Info-goto-node "(xemacs)Packages")]
        ["%_Getting Started with XEmacs" (Info-goto-node "(New-Users-Guide)")]
-       ["XEmacs In%_ternals Manual" (Info-goto-node "(Internals)")]
+       ["%_XEmacs Internals Manual" (Info-goto-node "(Internals)")]
        ["%_How to Use Info" (Info-goto-node "(Info)")]
        "-----"
        ["Lookup %_Key Sequence in User's Manual..."
@@ -1622,7 +1622,7 @@
        ["Lookup %_Command in User's Manual..." Info-goto-emacs-command-node]
        ["Lookup %_Function in Lisp Reference..." Info-elisp-ref]
        "-----"
-       ["Search %_Index in User's Manual/Lispref..."
+       ["Find %_Topic in User's Manual/Lispref..."
 	Info-search-index-in-xemacs-and-lispref]
        ["%_Search Text in User's Manual..." Info-search-text-in-xemacs]
        ["S%_earch Text in Lisp Reference..."
--- a/lisp/text-props.el	Sat Feb 08 02:28:15 2003 +0000
+++ b/lisp/text-props.el	Sat Feb 08 02:29:55 2003 +0000
@@ -234,7 +234,7 @@
     (setq start (next-single-property-change start prop buffer-or-string end)))
   ;; we have to insert a special check for end due to the illogical
   ;; definition of next-single-property-change (blame FSF for this).
-  (if (eq start end) nil start))
+  (if (and start (>= start end)) nil start))
 
 (defun text-property-not-all (start end prop value &optional buffer-or-string)
   "Check text from START to END to see if PROP is ever not `eq' to VALUE.
@@ -248,7 +248,7 @@
 					       buffer-or-string end)))
       ;; we have to insert a special check for end due to the illogical
       ;; definition of previous-single-property-change (blame FSF for this).
-      (if (eq retval end) nil retval))))
+      (if (and retval (>= retval end)) nil retval))))
 
 ;; Older versions that only work sometimes (when VALUE is non-nil
 ;; for text-property-any, and maybe only when VALUE is nil for
--- a/lisp/update-elc.el	Sat Feb 08 02:28:15 2003 +0000
+++ b/lisp/update-elc.el	Sat Feb 08 02:29:55 2003 +0000
@@ -107,6 +107,7 @@
   '("paths.el"
     "dumped-lisp.el"
     "dumped-pkg-lisp.el"
+    "raw-process.el"
     "version.el"
     "very-early-lisp.el")
   "Lisp files that should not be byte compiled.")
--- a/src/lread.c	Sat Feb 08 02:28:15 2003 +0000
+++ b/src/lread.c	Sat Feb 08 02:29:55 2003 +0000
@@ -501,7 +501,6 @@
   int reading_elc = 0;
   int from_require = EQ (nomessage, Qrequire);
   int message_p = NILP (nomessage) || load_always_display_messages;
-  static Lisp_Object last_file_loaded;
   struct stat s1, s2;
   Ibyte *spaces = alloca_ibytes (load_in_progress * 2 + 10);
   int i;
@@ -509,9 +508,6 @@
   GCPRO4 (file, newer, older, found);
   CHECK_STRING (file);
 
-  if (noninteractive)
-    last_file_loaded = file;
-
   /* If file name is magic, call the handler.  */
   handler = Ffind_file_name_handler (file, Qload);
   if (!NILP (handler))
@@ -752,14 +748,6 @@
       }
   }
 
-  if (message_p && noninteractive && !EQ (last_file_loaded, file))
-    {
-      if (from_require)
-	message ("%sRequiring %s ...done", spaces, XSTRING_DATA (file));
-      else
-	message ("%sLoading %s ...done", spaces, XSTRING_DATA (file));
-    }
-
   if (!noninteractive)
     PRINT_LOADING_MESSAGE ("done");