Mercurial > hg > xemacs-beta

comparison lisp/prim/subr.el @ 4:b82b59fe008d r19-15b3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b3
author cvs
date Mon, 13 Aug 2007 08:46:56 +0200
parents ac2d302a0011
children bcdc7deadc19
comparison
equal deleted inserted replaced
3:30df88044ec6 4:b82b59fe008d
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 ;; General Public License for more details. 17 ;; General Public License for more details.
18 18
19 ;; You should have received a copy of the GNU General Public License 19 ;; You should have received a copy of the GNU General Public License
20 ;; along with XEmacs; see the file COPYING. If not, write to the Free 20 ;; along with XEmacs; see the file COPYING. If not, write to the Free
21 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 21 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
22 22 ;; 02111-1307, USA.
23 ;;; Synched up with: FSF 19.30. 23
24 ;;; Synched up with: FSF 19.34.
25
26 ;;; Commentary:
27
28 ;; There's not a whole lot in common now with the FSF version,
29 ;; be wary when applying differences. I've left in a number of lines
30 ;; of commentary just to give diff(1) something to synch itself with to
31 ;; provide useful context diffs. -sb
24 32
25 ;;; Code: 33 ;;; Code:
26 34
27 35
28 ;;;; Lisp language features. 36 ;;;; Lisp language features.
44 BODY should be a list of lisp expressions." 52 BODY should be a list of lisp expressions."
45 ;; Note that this definition should not use backquotes; subr.el should not 53 ;; Note that this definition should not use backquotes; subr.el should not
46 ;; depend on backquote.el. 54 ;; depend on backquote.el.
47 ;; #### - I don't see why. So long as backquote.el doesn't use anything 55 ;; #### - I don't see why. So long as backquote.el doesn't use anything
48 ;; from subr.el, there's no problem with using backquotes here. --Stig 56 ;; from subr.el, there's no problem with using backquotes here. --Stig
49 (list 'function (cons 'lambda cdr))) 57 ;;(list 'function (cons 'lambda cdr)))
50 58 `(function (lambda ,@cdr)))
59
60 (defmacro defun-when-void (&rest args)
61 "Define a function, just like `defun', unless it's already defined.
62 Used for compatibility among different emacs variants."
63 `(if (fboundp ',(car args))
64 nil
65 (defun ,@args)))
66
67 (defmacro define-function-when-void (&rest args)
68 "Define a function, just like `define-function', unless it's already defined.
69 Used for compatibility among different emacs variants."
70 `(if (fboundp ,(car args))
71 nil
72 (define-function ,@args)))
73
74 ;;;; Keymap support.
75 ;; XEmacs: removed to keymap.el
76
77 ;;;; The global keymap tree.
78
79 ;;; global-map, esc-map, and ctl-x-map have their values set up in
80 ;;; keymap.c; we just give them docstrings here.
81
82 ;;;; Event manipulation functions.
83
84 ;; The call to `read' is to ensure that the value is computed at load time
85 ;; and not compiled into the .elc file. The value is negative on most
86 ;; machines, but not on all!
87 ;; XEmacs: This stuff is done in C Code.
88
89 ;;;; Obsolescent names for functions.
90 ;; XEmacs: not used.
91
92 ;; XEmacs:
51 (define-function 'not 'null) 93 (define-function 'not 'null)
52 (if (not (fboundp 'numberp)) 94 (define-function-when-void 'numberp 'intergerp) ; different when floats
53 (define-function 'numberp 'integerp)) ; different when floats
54 95
55 (defun local-variable-if-set-p (sym buffer) 96 (defun local-variable-if-set-p (sym buffer)
56 "Return t if SYM would be local to BUFFER after it is set. 97 "Return t if SYM would be local to BUFFER after it is set.
57 A nil value for BUFFER is *not* the same as (current-buffer), but 98 A nil value for BUFFER is *not* the same as (current-buffer), but
58 can be used to determine whether `make-variable-buffer-local' has been 99 can be used to determine whether `make-variable-buffer-local' has been
60 (local-variable-p sym buffer t)) 101 (local-variable-p sym buffer t))
61 102
62 103
63 ;;;; Hook manipulation functions. 104 ;;;; Hook manipulation functions.
64 105
106 ;; (defconst run-hooks 'run-hooks ...)
107
65 (defun make-local-hook (hook) 108 (defun make-local-hook (hook)
66 "Make the hook HOOK local to the current buffer. 109 "Make the hook HOOK local to the current buffer.
67 When a hook is local, its local and global values 110 When a hook is local, its local and global values
68 work in concert: running the hook actually runs all the hook 111 work in concert: running the hook actually runs all the hook
69 functions listed in *either* the local value *or* the global value 112 functions listed in *either* the local value *or* the global value
78 121
79 This function does nothing if HOOK is already local in the current 122 This function does nothing if HOOK is already local in the current
80 buffer. 123 buffer.
81 124
82 Do not use `make-local-variable' to make a hook variable buffer-local." 125 Do not use `make-local-variable' to make a hook variable buffer-local."
83 (if (local-variable-p hook (current-buffer)) 126 (if (local-variable-p hook (current-buffer)) ; XEmacs
84 nil 127 nil
85 (or (boundp hook) (set hook nil)) 128 (or (boundp hook) (set hook nil))
86 (make-local-variable hook) 129 (make-local-variable hook)
87 (set hook (list t)))) 130 (set hook (list t))))
88 131
100 `make-local-hook', not `make-local-variable'. 143 `make-local-hook', not `make-local-variable'.
101 144
102 HOOK should be a symbol, and FUNCTION may be any valid function. If 145 HOOK should be a symbol, and FUNCTION may be any valid function. If
103 HOOK is void, it is first set to nil. If HOOK's value is a single 146 HOOK is void, it is first set to nil. If HOOK's value is a single
104 function, it is changed to a list of functions." 147 function, it is changed to a list of functions."
105 ;(interactive "SAdd to hook-var (symbol): \naAdd which function to %s? ")
106 (or (boundp hook) (set hook nil)) 148 (or (boundp hook) (set hook nil))
107 (or (default-boundp hook) (set-default hook nil)) 149 (or (default-boundp hook) (set-default hook nil))
108 ;; If the hook value is a single function, turn it into a list. 150 ;; If the hook value is a single function, turn it into a list.
109 (let ((old (symbol-value hook))) 151 (let ((old (symbol-value hook)))
110 (if (or (not (listp old)) (eq (car old) 'lambda)) 152 (if (or (not (listp old)) (eq (car old) 'lambda))
111 (set hook (list old)))) 153 (set hook (list old))))
112 (if (or local 154 (if (or local
113 ;; Detect the case where make-local-variable was used on a hook 155 ;; Detect the case where make-local-variable was used on a hook
114 ;; and do what we used to do. 156 ;; and do what we used to do.
115 (and (local-variable-if-set-p hook (current-buffer)) 157 (and (local-variable-if-set-p hook (current-buffer)) ; XEmacs
116 (not (memq t (symbol-value hook))))) 158 (not (memq t (symbol-value hook)))))
117 ;; Alter the local value only. 159 ;; Alter the local value only.
118 (or (if (consp function) 160 (or (if (consp function)
119 (member function (symbol-value hook)) 161 (member function (symbol-value hook))
120 (memq function (symbol-value hook))) 162 (memq function (symbol-value hook)))
168 (setq hook-value nil))) 210 (setq hook-value nil)))
169 (set-default hook hook-value))))) 211 (set-default hook hook-value)))))
170 212
171 (defun add-to-list (list-var element) 213 (defun add-to-list (list-var element)
172 "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet. 214 "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet.
215 The test for presence of ELEMENT is done with `equal'.
173 If you want to use `add-to-list' on a variable that is not defined 216 If you want to use `add-to-list' on a variable that is not defined
174 until a certain package is loaded, you should put the call to `add-to-list' 217 until a certain package is loaded, you should put the call to `add-to-list'
175 into a hook function that will be run only after loading the package. 218 into a hook function that will be run only after loading the package.
176 `eval-after-load' provides one way to do this. In some cases 219 `eval-after-load' provides one way to do this. In some cases
177 other hooks, such as major mode hooks, can do the job." 220 other hooks, such as major mode hooks, can do the job."
178 (or (member element (symbol-value list-var)) 221 (or (member element (symbol-value list-var))
179 (set list-var (cons element (symbol-value list-var))))) 222 (set list-var (cons element (symbol-value list-var)))))
180 223
224 ;; XEmacs additions
181 ;; called by Fkill_buffer() 225 ;; called by Fkill_buffer()
182 (defvar kill-buffer-hook nil 226 (defvar kill-buffer-hook nil
183 "Function or functions to be called when a buffer is killed. 227 "Function or functions to be called when a buffer is killed.
184 The value of this variable may be buffer-local. 228 The value of this variable may be buffer-local.
185 The buffer about to be killed is current when this hook is run.") 229 The buffer about to be killed is current when this hook is run.")
191 235
192 ;; not obsolete. 236 ;; not obsolete.
193 (define-function 'rplaca 'setcar) 237 (define-function 'rplaca 'setcar)
194 (define-function 'rplacd 'setcdr) 238 (define-function 'rplacd 'setcdr)
195 239
240 ;; XEmacs
196 (defun mapvector (__function __seq) 241 (defun mapvector (__function __seq)
197 "Apply FUNCTION to each element of SEQ, making a vector of the results. 242 "Apply FUNCTION to each element of SEQ, making a vector of the results.
198 The result is a vector of the same length as SEQ. 243 The result is a vector of the same length as SEQ.
199 SEQ may be a list, a vector or a string." 244 SEQ may be a list, a vector or a string."
200 (let* ((len (length __seq)) 245 (let* ((len (length __seq))
207 (setq i (+ i 1))) 252 (setq i (+ i 1)))
208 vec)) 253 vec))
209 254
210 ;;;; String functions. 255 ;;;; String functions.
211 256
257 ;; XEmacs
212 (defun replace-in-string (str regexp newtext &optional literal) 258 (defun replace-in-string (str regexp newtext &optional literal)
213 "Replaces all matches in STR for REGEXP with NEWTEXT string. 259 "Replaces all matches in STR for REGEXP with NEWTEXT string.
214 Optional LITERAL non-nil means do a literal replacement. 260 Optional LITERAL non-nil means do a literal replacement.
215 Otherwise treat \\ in NEWTEXT string as special: 261 Otherwise treat \\ in NEWTEXT string as special:
216 \\& means substitute original matched text, 262 \\& means substitute original matched text,
530 (define-function 'search-backward-regexp (symbol-function 're-search-backward)) 576 (define-function 'search-backward-regexp (symbol-function 're-search-backward))
531 (define-function 'remove-directory 'delete-directory) 577 (define-function 'remove-directory 'delete-directory)
532 (define-function 'set-match-data 'store-match-data) 578 (define-function 'set-match-data 'store-match-data)
533 (define-function 'send-string-to-terminal 'external-debugging-output) 579 (define-function 'send-string-to-terminal 'external-debugging-output)
534 (define-function 'buffer-string 'buffer-substring) 580 (define-function 'buffer-string 'buffer-substring)
581
582 ;;; subr.el ends here