# HG changeset patch # User youngs # Date 1025050276 0 # Node ID 1e9272790fe032dfe63356498e0df056e406d5a4 # Parent f503f1607e8b1d75b52fd719f41014f6d3272b9f [xemacs-hg @ 2002-06-26 00:11:15 by youngs] 2002-06-24 John Paul Wallington * 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 * code-files.el (load): Look for a binary module if no Lisp file with the correct name is found. diff -r f503f1607e8b -r 1e9272790fe0 lisp/ChangeLog --- 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 + + * 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 + + * code-files.el (load): Look for a binary module if no Lisp file + with the correct name is found. + 2002-06-22 Ville Skyttä * subr.el (add-to-list): Sync with GNU Emacs 21.2, adding the diff -r f503f1607e8b -r 1e9272790fe0 lisp/code-files.el --- 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. diff -r f503f1607e8b -r 1e9272790fe0 lisp/obsolete.el --- 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) diff -r f503f1607e8b -r 1e9272790fe0 lisp/subr.el --- 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.