changeset 883:1e9272790fe0

[xemacs-hg @ 2002-06-26 00:11:15 by youngs] 2002-06-24 John Paul Wallington <jpw@shootybangbang.com> * obsolete.el (frame-parameter): New compatibility function. (makehash): Ditto. (buffer-local-value): Ditto. (line-beginning-position): New compatibility alias for `point-at-bol'. (line-end-position): New compatibility alias for `point-at-eol'. * subr.el (with-temp-message): New function; sync with GNU Emacs 21. (bound-and-true-p): Ditto. (propertize): New function. (delete-and-extract-region): Ditto. 2002-06-24 Jerry James <james@xemacs.org> * code-files.el (load): Look for a binary module if no Lisp file with the correct name is found.
author youngs
date Wed, 26 Jun 2002 00:11:16 +0000
parents f503f1607e8b
children 0048cad4b034
files lisp/ChangeLog lisp/code-files.el lisp/obsolete.el lisp/subr.el
diffstat 4 files changed, 132 insertions(+), 39 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Tue Jun 25 21:20:47 2002 +0000
+++ b/lisp/ChangeLog	Wed Jun 26 00:11:16 2002 +0000
@@ -1,3 +1,21 @@
+2002-06-24  John Paul Wallington  <jpw@shootybangbang.com>
+
+	* obsolete.el (frame-parameter): New compatibility function.
+	(makehash): Ditto.
+	(buffer-local-value): Ditto.
+	(line-beginning-position): New compatibility alias for `point-at-bol'.
+	(line-end-position): New compatibility alias for `point-at-eol'.
+
+	* subr.el (with-temp-message): New function; sync with GNU Emacs 21.
+	(bound-and-true-p): Ditto.
+	(propertize): New function.
+	(delete-and-extract-region): Ditto.
+
+2002-06-24  Jerry James  <james@xemacs.org>
+
+	* code-files.el (load): Look for a binary module if no Lisp file
+	with the correct name is found.
+
 2002-06-22  Ville Skyttä  <ville.skytta@xemacs.org>
 
 	* subr.el (add-to-list): Sync with GNU Emacs 21.2, adding the
--- a/lisp/code-files.el	Tue Jun 25 21:20:47 2002 +0000
+++ b/lisp/code-files.el	Wed Jun 26 00:11:16 2002 +0000
@@ -220,56 +220,69 @@
 ;(defun convert-mbox-coding-system (filename visit start end) ...)
 
 (defun load (file &optional noerror nomessage nosuffix)
-  "Execute a file of Lisp code named FILE.
-First tries FILE with .elc appended, then tries with .el,
- then tries FILE unmodified.  Searches directories in load-path.
+  "Execute a file of Lisp code named FILE, or load a binary module.
+First tries to find a Lisp FILE with .elc appended, then with .el, then with
+ FILE unmodified.  If unsuccessful, tries to find a binary module FILE with
+ .ell appended, then with .dll, then with .so, and finally unmodified.
+Searches directories in load-path for Lisp files, and in module-load-path
+ for binary modules.
 If optional second arg NOERROR is non-nil,
  report no error if FILE doesn't exist.
 Print messages at start and end of loading unless
  optional third arg NOMESSAGE is non-nil.
 If optional fourth arg NOSUFFIX is non-nil, don't try adding
- suffixes .elc or .el to the specified name FILE.
+ suffixes .elc, .el, or .ell to the specified name FILE.
 Return t if file exists."
   (let* ((filename (substitute-in-file-name file))
 	 (handler (find-file-name-handler filename 'load))
 	 (path nil))
     (if handler
 	(funcall handler 'load filename noerror nomessage nosuffix)
-      (if (or (<= (length filename) 0)
-	      (null (setq path
-			  (locate-file filename load-path
+      ;; First try to load a Lisp file
+      (if (and (> (length filename) 0)
+	       (setq path (locate-file filename load-path
 				       (and (not nosuffix)
-					    '(".elc" ".el" ""))))))
-	  (and (null noerror)
-	       (signal 'file-error (list "Cannot open load file" filename)))
-	;; now use the internal load to actually load the file.
-	(load-internal
-	 file noerror nomessage nosuffix
-	 (let ((elc ; use string= instead of string-match to keep match-data.
+					    '(".elc" ".el" "")))))
+	  ;; now use the internal load to actually load the file.
+	  (load-internal
+	   file noerror nomessage nosuffix
+	   (let ((elc ; use string= instead of string-match to keep match-data.
 		(equalp ".elc" (substring path -4))))
-	   (or (and (not elc) coding-system-for-read) ; prefer for source file
-	       ;; find magic-cookie
-	       (let ((codesys (find-coding-system-magic-cookie-in-file path)))
-		 (when codesys
-		   (setq codesys (intern codesys))
-		   (if (find-coding-system codesys) codesys)))
-	       (if elc
-		   ;; if reading a byte-compiled file and we didn't find
-		   ;; a coding-system magic cookie, then use `binary'.
-		   ;; We need to guarantee that we never do autodetection
-		   ;; on byte-compiled files because confusion here would
-		   ;; be a very bad thing.  Pre-existing byte-compiled
-		   ;; files are always in the `binary' coding system.
-		   ;; Also, byte-compiled files always use `lf' to terminate
-		   ;; a line; don't risk confusion here either.
-		   'binary
-		 (or (find-file-coding-system-for-read-from-filename path)
-		     ;; looking up in `file-coding-system-alist'.
-		     ;; otherwise use `buffer-file-coding-system-for-read',
-		     ;; as normal
-		     buffer-file-coding-system-for-read)
-		 )))
-	 )))))
+	     (or (and (not elc) coding-system-for-read) ;prefer for source file
+		 ;; find magic-cookie
+		 (let ((codesys
+			(find-coding-system-magic-cookie-in-file path)))
+		   (when codesys
+		     (setq codesys (intern codesys))
+		     (if (find-coding-system codesys) codesys)))
+		 (if elc
+		     ;; if reading a byte-compiled file and we didn't find
+		     ;; a coding-system magic cookie, then use `binary'.
+		     ;; We need to guarantee that we never do autodetection
+		     ;; on byte-compiled files because confusion here would
+		     ;; be a very bad thing.  Pre-existing byte-compiled
+		     ;; files are always in the `binary' coding system.
+		     ;; Also, byte-compiled files always use `lf' to terminate
+		     ;; a line; don't risk confusion here either.
+		     'binary
+		   (or (find-file-coding-system-for-read-from-filename path)
+		       ;; looking up in `file-coding-system-alist'.
+		       ;; otherwise use `buffer-file-coding-system-for-read',
+		       ;; as normal
+		       buffer-file-coding-system-for-read)
+		   ))))
+	;; The file name is invalid, or we want to load a binary module
+	(if (and (> (length filename) 0)
+		 (setq path (locate-file filename module-load-path
+					 (and (not nosuffix)
+					      '(".ell" ".dll" ".so" "")))))
+	    (if (featurep 'modules)
+		(let ((load-modules-quietly nomessage))
+		  (load-module path))
+	      (signal 'file-error '("This XEmacs does not support modules")))
+	  (and (null noerror)
+	       (signal 'file-error (list "Cannot open load file" filename))))
+	))))
 
 (defvar insert-file-contents-access-hook nil
   "A hook to make a file accessible before reading it.
--- a/lisp/obsolete.el	Tue Jun 25 21:20:47 2002 +0000
+++ b/lisp/obsolete.el	Wed Jun 26 00:11:16 2002 +0000
@@ -148,6 +148,12 @@
   ;; future.
   (destructive-plist-to-alist (frame-properties frame)))
 
+(make-compatible 'frame-parameter 'frame-property)
+(defun frame-parameter (frame parameter)
+  "Return FRAME's value for parameter PARAMETER.
+If FRAME is nil, describe the currently selected frame."
+  (cdr (assq parameter (frame-parameters frame))))
+
 (make-compatible 'modify-frame-parameters 'set-frame-properties)
 (defun modify-frame-parameters (frame alist)
   "Modify the properties of frame FRAME according to ALIST.
@@ -263,6 +269,23 @@
 (define-compatible-function-alias 'assq-delete-all
   'remassq) ;GNU 21.1
 
+(defun makehash (&optional test)
+  "Create a new hash table.
+Optional first argument TEST specifies how to compare keys in the table.  
+Predefined tests are `eq', `eql', and `equal'.  Default is `eql'."
+  (make-hash-table :test test))
+(make-compatible 'makehash 'make-hash-table)
+
+(defun buffer-local-value (variable buffer)
+  "Return the value of VARIABLE in BUFFER.
+If VARIABLE does not have a buffer-local binding in BUFFER, the value
+is the default binding of variable."
+  (symbol-value-in-buffer variable buffer))
+(make-compatible 'buffer-local-value 'symbol-value-in-buffer)
+
+(define-compatible-function-alias 'line-beginning-position 'point-at-bol)
+(define-compatible-function-alias 'line-end-position 'point-at-eol)
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;; modeline
 
 (define-compatible-function-alias 'redraw-mode-line 'redraw-modeline)
--- a/lisp/subr.el	Tue Jun 25 21:20:47 2002 +0000
+++ b/lisp/subr.el	Wed Jun 26 00:11:16 2002 +0000
@@ -486,6 +486,23 @@
 	 (and (buffer-name ,temp-buffer)
 	      (kill-buffer ,temp-buffer))))))
 
+(defmacro with-temp-message (message &rest body)
+  "Display MESSAGE temporarily while BODY is evaluated.
+The original message is restored to the echo area after BODY has finished.
+The value returned is the value of the last form in BODY."
+  (let ((current-message (make-symbol "current-message"))
+	(temp-message (make-symbol "with-temp-message")))
+    `(let ((,temp-message ,message)
+	   (,current-message))
+       (unwind-protect
+	   (progn
+	     (when ,temp-message
+	       (setq ,current-message (current-message))
+	       (message "%s" ,temp-message))
+	     ,@body)
+	 (and ,temp-message ,current-message
+	      (message "%s" ,current-message))))))
+
 (defmacro with-temp-buffer (&rest forms)
   "Create a temporary buffer, and evaluate FORMS there like `progn'.
 See also `with-temp-file' and `with-output-to-string'."
@@ -1108,6 +1125,30 @@
   (interactive)
   nil)
 
+;; defined in lisp/bindings.el in GNU Emacs.
+(defmacro bound-and-true-p (var)
+  "Return the value of symbol VAR if it is bound, else nil."
+  `(and (boundp (quote ,var)) ,var))
+
+;; `propertize' is a builtin in GNU Emacs 21.
+(defun propertize (string &rest properties)
+  "Return a copy of STRING with text properties added.
+First argument is the string to copy.
+Remaining arguments form a sequence of PROPERTY VALUE pairs for text
+properties to add to the result."
+  (let ((str (copy-sequence string)))
+    (add-text-properties 0 (length str)
+			 properties
+			 str)
+    str))
+
+;; `delete-and-extract-region' is a builtin in GNU Emacs 21.
+(defun delete-and-extract-region (start end)
+  "Delete the text between START and END and return it."
+  (let ((region (buffer-substring start end)))
+    (delete-region start end)
+    region))
+
 (define-function 'eval-in-buffer 'with-current-buffer)
 (make-obsolete 'eval-in-buffer 'with-current-buffer)
 
@@ -1132,8 +1173,6 @@
 ;;      (compiled-function-p object)
 ;;      (eq (car-safe object) 'lambda)))
 
-
-
 (defun function-interactive (function)
   "Return the interactive specification of FUNCTION.
 FUNCTION can be any funcallable object.