Mercurial > hg > xemacs-beta

comparison lisp/prim/subr.el @ 72:b9518feda344 r20-0b31

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b31
author cvs
date Mon, 13 Aug 2007 09:03:46 +0200
parents 131b0175ea99
children c7528f8e288d
comparison
equal deleted inserted replaced
71:bae944334fa4 72:b9518feda344
15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of 15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
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 20 ;; along with XEmacs; see the file COPYING. If not, write to the Free
21 ;; Free Software Foundation, 59 Temple Place - Suite 330, 21 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
22 ;; Boston, MA 02111-1307, USA. 22 ;; 02111-1307, USA.
23 23
24 ;;; Synched up with: FSF 19.30. 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
25 32
26 ;;; Code: 33 ;;; Code:
27 34
28 35
29 ;;;; Lisp language features. 36 ;;;; Lisp language features.
62 Used for compatibility among different emacs variants." 69 Used for compatibility among different emacs variants."
63 `(if (fboundp ,(car args)) 70 `(if (fboundp ,(car args))
64 nil 71 nil
65 (define-function ,@args))) 72 (define-function ,@args)))
66 73
74
75 ;;;; Keymap support.
76 ;; XEmacs: removed to keymap.el
77
78 ;;;; The global keymap tree.
79
80 ;;; global-map, esc-map, and ctl-x-map have their values set up in
81 ;;; keymap.c; we just give them docstrings here.
82
83 ;;;; Event manipulation functions.
84
85 ;; The call to `read' is to ensure that the value is computed at load time
86 ;; and not compiled into the .elc file. The value is negative on most
87 ;; machines, but not on all!
88 ;; XEmacs: This stuff is done in C Code.
89
90 ;;;; Obsolescent names for functions.
91 ;; XEmacs: not used.
92
93 ;; XEmacs:
67 (define-function 'not 'null) 94 (define-function 'not 'null)
68 (define-function-when-void 'numberp 'intergerp) ; different when floats 95 (define-function-when-void 'numberp 'intergerp) ; different when floats
69 96
70 (defun local-variable-if-set-p (sym buffer) 97 (defun local-variable-if-set-p (sym buffer)
71 "Return t if SYM would be local to BUFFER after it is set. 98 "Return t if SYM would be local to BUFFER after it is set.
75 (local-variable-p sym buffer t)) 102 (local-variable-p sym buffer t))
76 103
77 104
78 ;;;; Hook manipulation functions. 105 ;;;; Hook manipulation functions.
79 106
107 ;; (defconst run-hooks 'run-hooks ...)
108
80 (defun make-local-hook (hook) 109 (defun make-local-hook (hook)
81 "Make the hook HOOK local to the current buffer. 110 "Make the hook HOOK local to the current buffer.
82 When a hook is local, its local and global values 111 When a hook is local, its local and global values
83 work in concert: running the hook actually runs all the hook 112 work in concert: running the hook actually runs all the hook
84 functions listed in *either* the local value *or* the global value 113 functions listed in *either* the local value *or* the global value
93 122
94 This function does nothing if HOOK is already local in the current 123 This function does nothing if HOOK is already local in the current
95 buffer. 124 buffer.
96 125
97 Do not use `make-local-variable' to make a hook variable buffer-local." 126 Do not use `make-local-variable' to make a hook variable buffer-local."
98 (if (local-variable-p hook (current-buffer)) 127 (if (local-variable-p hook (current-buffer)) ; XEmacs
99 nil 128 nil
100 (or (boundp hook) (set hook nil)) 129 (or (boundp hook) (set hook nil))
101 (make-local-variable hook) 130 (make-local-variable hook)
102 (set hook (list t)))) 131 (set hook (list t))))
103 132
115 `make-local-hook', not `make-local-variable'. 144 `make-local-hook', not `make-local-variable'.
116 145
117 HOOK should be a symbol, and FUNCTION may be any valid function. If 146 HOOK should be a symbol, and FUNCTION may be any valid function. If
118 HOOK is void, it is first set to nil. If HOOK's value is a single 147 HOOK is void, it is first set to nil. If HOOK's value is a single
119 function, it is changed to a list of functions." 148 function, it is changed to a list of functions."
120 ;(interactive "SAdd to hook-var (symbol): \naAdd which function to %s? ")
121 (or (boundp hook) (set hook nil)) 149 (or (boundp hook) (set hook nil))
122 (or (default-boundp hook) (set-default hook nil)) 150 (or (default-boundp hook) (set-default hook nil))
123 ;; If the hook value is a single function, turn it into a list. 151 ;; If the hook value is a single function, turn it into a list.
124 (let ((old (symbol-value hook))) 152 (let ((old (symbol-value hook)))
125 (if (or (not (listp old)) (eq (car old) 'lambda)) 153 (if (or (not (listp old)) (eq (car old) 'lambda))
126 (set hook (list old)))) 154 (set hook (list old))))
127 (if (or local 155 (if (or local
128 ;; Detect the case where make-local-variable was used on a hook 156 ;; Detect the case where make-local-variable was used on a hook
129 ;; and do what we used to do. 157 ;; and do what we used to do.
130 (and (local-variable-if-set-p hook (current-buffer)) 158 (and (local-variable-if-set-p hook (current-buffer)) ; XEmacs
131 (not (memq t (symbol-value hook))))) 159 (not (memq t (symbol-value hook)))))
132 ;; Alter the local value only. 160 ;; Alter the local value only.
133 (or (if (consp function) 161 (or (if (consp function)
134 (member function (symbol-value hook)) 162 (member function (symbol-value hook))
135 (memq function (symbol-value hook))) 163 (memq function (symbol-value hook)))
183 (setq hook-value nil))) 211 (setq hook-value nil)))
184 (set-default hook hook-value))))) 212 (set-default hook hook-value)))))
185 213
186 (defun add-to-list (list-var element) 214 (defun add-to-list (list-var element)
187 "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet. 215 "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet.
216 The test for presence of ELEMENT is done with `equal'.
188 If you want to use `add-to-list' on a variable that is not defined 217 If you want to use `add-to-list' on a variable that is not defined
189 until a certain package is loaded, you should put the call to `add-to-list' 218 until a certain package is loaded, you should put the call to `add-to-list'
190 into a hook function that will be run only after loading the package. 219 into a hook function that will be run only after loading the package.
191 `eval-after-load' provides one way to do this. In some cases 220 `eval-after-load' provides one way to do this. In some cases
192 other hooks, such as major mode hooks, can do the job." 221 other hooks, such as major mode hooks, can do the job."
193 (or (member element (symbol-value list-var)) 222 (or (member element (symbol-value list-var))
194 (set list-var (cons element (symbol-value list-var))))) 223 (set list-var (cons element (symbol-value list-var)))))
195 224
225 ;; XEmacs additions
196 ;; called by Fkill_buffer() 226 ;; called by Fkill_buffer()
197 (defvar kill-buffer-hook nil 227 (defvar kill-buffer-hook nil
198 "Function or functions to be called when a buffer is killed. 228 "Function or functions to be called when a buffer is killed.
199 The value of this variable may be buffer-local. 229 The value of this variable may be buffer-local.
200 The buffer about to be killed is current when this hook is run.") 230 The buffer about to be killed is current when this hook is run.")
206 236
207 ;; not obsolete. 237 ;; not obsolete.
208 (define-function 'rplaca 'setcar) 238 (define-function 'rplaca 'setcar)
209 (define-function 'rplacd 'setcdr) 239 (define-function 'rplacd 'setcdr)
210 240
241 ;; XEmacs
211 (defun mapvector (__function __seq) 242 (defun mapvector (__function __seq)
212 "Apply FUNCTION to each element of SEQ, making a vector of the results. 243 "Apply FUNCTION to each element of SEQ, making a vector of the results.
213 The result is a vector of the same length as SEQ. 244 The result is a vector of the same length as SEQ.
214 SEQ may be a list, a vector or a string." 245 SEQ may be a list, a vector or a string."
215 (let* ((len (length __seq)) 246 (let* ((len (length __seq))
222 (setq i (+ i 1))) 253 (setq i (+ i 1)))
223 vec)) 254 vec))
224 255
225 ;;;; String functions. 256 ;;;; String functions.
226 257
258 ;; XEmacs
227 (defun replace-in-string (str regexp newtext &optional literal) 259 (defun replace-in-string (str regexp newtext &optional literal)
228 "Replaces all matches in STR for REGEXP with NEWTEXT string. 260 "Replaces all matches in STR for REGEXP with NEWTEXT string.
229 Optional LITERAL non-nil means do a literal replacement. 261 Optional LITERAL non-nil means do a literal replacement.
230 Otherwise treat \\ in NEWTEXT string as special: 262 Otherwise treat \\ in NEWTEXT string as special:
231 \\& means substitute original matched text, 263 \\& means substitute original matched text,
545 (define-function 'search-backward-regexp (symbol-function 're-search-backward)) 577 (define-function 'search-backward-regexp (symbol-function 're-search-backward))
546 (define-function 'remove-directory 'delete-directory) 578 (define-function 'remove-directory 'delete-directory)
547 (define-function 'set-match-data 'store-match-data) 579 (define-function 'set-match-data 'store-match-data)
548 (define-function 'send-string-to-terminal 'external-debugging-output) 580 (define-function 'send-string-to-terminal 'external-debugging-output)
549 (define-function 'buffer-string 'buffer-substring) 581 (define-function 'buffer-string 'buffer-substring)
582
583 ;;; subr.el ends here