1 ;;; poe-18.el --- poe API implementation for Emacs 18.*
3 ;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc.
5 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
6 ;; Keywords: emulation, compatibility
8 ;; This file is part of APEL (A Portable Emacs Library).
10 ;; This program is free software; you can redistribute it and/or
11 ;; modify it under the terms of the GNU General Public License as
12 ;; published by the Free Software Foundation; either version 2, or (at
13 ;; your option) any later version.
15 ;; This program is distributed in the hope that it will be useful, but
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with this program; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
27 ;; Note to developers:
29 ;; If old (v18) compiler is used, top-level macros are expanded at
30 ;; *load-time*, not compile-time. So, you cannot use macros defined
31 ;; in this file using `defmacro-maybe'. Especially, you cannot use
32 ;; `eval-when-compile' and `eval-and-compile' in this file.
36 (provide 'poe-18) ; beware of circular dependency.
37 (require 'poe) ; load definitions of `*-maybe'.
42 (defvar-maybe buffer-undo-list nil)
45 ;;; @ Emacs 19 emulation
48 (defvar-maybe data-directory exec-directory)
57 (defun delete (elt list)
58 "Delete by side effect any occurrences of ELT as a member of LIST.
59 The modified LIST is returned. Comparison is done with `equal'.
60 If the first member of LIST is ELT, deleting it is not a side effect;
61 it is simply using a different list.
62 Therefore, write `(setq foo (delete element foo))'
63 to be sure of changing the value of `foo'.
64 \[poe-18.el; EMACS 19 emulating function]"
65 (if (equal elt (car list))
69 (while (and rrest (not (equal elt (car rrest))))
72 (setcdr rest (cdr rrest))
75 (defun member (elt list)
76 "Return non-nil if ELT is an element of LIST. Comparison done with EQUAL.
77 The value is actually the tail of LIST whose car is ELT.
78 \[poe-18.el; EMACS 19 emulating function]"
79 (while (and list (not (equal elt (car list))))
80 (setq list (cdr list)))
84 ;;; @@ buffer-local variable
87 (defun default-boundp (symbol)
88 "Return t if SYMBOL has a non-void default value.
89 This is the value that is seen in buffers that do not have their own values
91 \[poe-18.el; EMACS 19 emulating function]"
94 (default-value symbol)
99 ;;; @@ environment variable
102 (autoload 'setenv "env"
103 "Set the value of the environment variable named VARIABLE to VALUE.
104 VARIABLE should be a string. VALUE is optional; if not provided or is
105 `nil', the environment variable VARIABLE will be removed.
106 This function works by modifying `process-environment'."
113 (defun defalias (sym newdef)
114 "Set SYMBOL's function definition to NEWVAL, and return NEWVAL.
115 Associates the function with the current load file, if any."
118 (defun byte-code-function-p (exp)
119 "T if OBJECT is a byte-compiled function object.
120 \[poe-18.el; EMACS 19 emulating function]"
122 (let ((rest (cdr (cdr exp)))
124 (if (stringp (car rest))
125 (setq rest (cdr rest)))
128 (setq elt (car rest))
130 (eq (car elt) 'byte-code))
132 (setq rest (cdr rest)))))))
135 ;;; @ Compilation Features
138 ;;; emulate all functions and macros of emacs-20.3/lisp/byte-run.el.
139 ;;; (note: jwz's original compiler and XEmacs compiler have some more
140 ;;; macros; they are "nuked" by rms in FSF version.)
142 (put 'inline 'lisp-indent-hook 0)
143 (defalias-maybe 'inline 'progn)
145 (put 'defsubst 'lisp-indent-hook 'defun)
146 (put 'defsubst 'edebug-form-spec 'defun)
147 (defmacro-maybe defsubst (name arglist &rest body)
148 "Define an inline function. The syntax is just like that of `defun'.
150 This emulating macro does not support function inlining because old \(v18\)
151 compiler does not support inlining feature.
152 \[poe-18.el; EMACS 19 emulating macro]"
153 (cons 'defun (cons name (cons arglist body))))
155 (defun-maybe make-obsolete (fn new)
156 "Make the byte-compiler warn that FUNCTION is obsolete.
157 The warning will say that NEW should be used instead.
158 If NEW is a string, that is the `use instead' message.
160 This emulating function does nothing because old \(v18\) compiler does not
161 support this feature.
162 \[poe-18.el; EMACS 19 emulating function]"
163 (interactive "aMake function obsolete: \nxObsoletion replacement: ")
166 (defun-maybe make-obsolete-variable (var new)
167 "Make the byte-compiler warn that VARIABLE is obsolete,
168 and NEW should be used instead. If NEW is a string, then that is the
169 `use instead' message.
171 This emulating function does nothing because old \(v18\) compiler does not
172 support this feature.
173 \[poe-18.el; EMACS 19 emulating function]"
174 (interactive "vMake variable obsolete: \nxObsoletion replacement: ")
177 (put 'dont-compile 'lisp-indent-hook 0)
178 (defmacro-maybe dont-compile (&rest body)
179 "Like `progn', but the body always runs interpreted \(not compiled\).
180 If you think you need this, you're probably making a mistake somewhere.
181 \[poe-18.el; EMACS 19 emulating macro]"
182 (list 'eval (list 'quote (if (cdr body) (cons 'progn body) (car body)))))
184 (put 'eval-when-compile 'lisp-indent-hook 0)
185 (defmacro-maybe eval-when-compile (&rest body)
186 "Like progn, but evaluates the body at compile-time.
188 This emulating macro does not work if used at top-level.
189 Top-level macros are expanded at load-time.
190 \[poe-18.el; EMACS 19 emulating macro]"
191 (list 'quote (eval (cons 'progn body))))
193 (put 'eval-and-compile 'lisp-indent-hook 0)
194 (defmacro-maybe eval-and-compile (&rest body)
195 "Like progn, but evaluates the body at compile-time as well as at load-time.
197 This emulating macro does not work if used at top-level.
198 Top-level macros are expanded at load-time.
199 \[poe-18.el; EMACS 19 emulating macro]"
200 ;; `form' is a parameter of `byte-compile-form'. kludge! kludge! kludge!
201 ;; this kludge prevents from evaluating `body' twice when this macro is
202 ;; expanded at load-time.
203 (if (and (boundp 'form)
204 (eq (car-safe form) 'eval-and-compile))
205 (eval (cons 'progn body)))
212 (defun set-text-properties (start end properties &optional object))
214 (defun remove-text-properties (start end properties &optional object))
220 (defun make-directory-internal (dirname)
221 "Create a directory. One argument, a file name string.
222 \[poe-18.el; EMACS 19 emulating function]"
223 (let ((dir (expand-file-name dirname)))
224 (if (file-exists-p dir)
225 (error "Creating directory: %s is already exist" dir)
226 (call-process "mkdir" nil nil nil dir))))
228 (defun make-directory (dir &optional parents)
229 "Create the directory DIR and any nonexistent parent dirs.
230 The second (optional) argument PARENTS says whether
231 to create parent directories if they don't exist.
232 \[poe-18.el; EMACS 19 emulating function]"
233 (let ((len (length dir))
236 (while (and (< p len) (string-match "[^/]*/?" dir p))
237 (setq p1 (match-end 0))
240 (setq path (substring dir 0 p1))
241 (if (not (file-directory-p path))
242 (cond ((file-exists-p path)
243 (error "Creating directory: %s is not directory" path))
245 (error "Creating directory: %s is not exist" path))
247 (make-directory-internal path))))
249 (make-directory-internal dir)))
251 ;; Imported from files.el of EMACS 19.33.
252 (defun parse-colon-path (cd-path)
253 "Explode a colon-separated list of paths into a string list."
255 (let (cd-prefix cd-list (cd-start 0) cd-colon)
256 (setq cd-path (concat cd-path path-separator))
257 (while (setq cd-colon (string-match path-separator cd-path cd-start))
260 (list (if (= cd-start cd-colon)
262 (substitute-in-file-name
263 (file-name-as-directory
264 (substring cd-path cd-start cd-colon)))))))
265 (setq cd-start (+ cd-colon 1)))
268 ;; Imported from files.el of EMACS 19.33.
269 (defun file-relative-name (filename &optional directory)
270 "Convert FILENAME to be relative to DIRECTORY (default: default-directory)."
271 (setq filename (expand-file-name filename)
272 directory (file-name-as-directory (expand-file-name
273 (or directory default-directory))))
275 (while (not (string-match (concat "^" (regexp-quote directory)) filename))
276 (setq directory (file-name-directory (substring directory 0 -1))
277 ancestor (concat "../" ancestor)))
278 (concat ancestor (substring filename (match-end 0)))))
280 (or (fboundp 'si:directory-files)
281 (fset 'si:directory-files (symbol-function 'directory-files)))
282 (defun directory-files (directory &optional full match nosort)
283 "Return a list of names of files in DIRECTORY.
284 There are three optional arguments:
285 If FULL is non-nil, return absolute file names. Otherwise return names
286 that are relative to the specified directory.
287 If MATCH is non-nil, mention only file names that match the regexp MATCH.
288 If NOSORT is dummy for compatibility.
289 \[poe-18.el; EMACS 19 emulating function]"
290 (si:directory-files directory full match))
293 ;;; @ Display Features
296 ;;; Imported from Emacs 19.30.
297 (defun force-mode-line-update (&optional all)
298 "Force the mode-line of the current buffer to be redisplayed.
299 With optional non-nil ALL, force redisplay of all mode-lines.
300 \[poe-18.el; Emacs 19 emulating function]"
301 (if all (save-excursion (set-buffer (other-buffer))))
302 (set-buffer-modified-p (buffer-modified-p)))
308 (cond ((boundp 'NEMACS)
309 (defvar emu:available-face-attribute-alist
311 ;;(bold . inversed-region)
312 (italic . underlined-region)
313 (underline . underlined-region)
316 ;; by YAMATE Keiichirou 1994/10/28
317 (defun attribute-add-narrow-attribute (attr from to)
318 (or (consp (symbol-value attr))
320 (let* ((attr-value (symbol-value attr))
321 (len (car attr-value))
324 (while (and (< posfrom len)
325 (> from (nth posfrom attr-value)))
326 (setq posfrom (1+ posfrom)))
328 (while (and (< posto len)
329 (> to (nth posto attr-value)))
330 (setq posto (1+ posto)))
331 (if (= posto posfrom)
332 (if (= (% posto 2) 1)
334 (= to (nth posto attr-value)))
335 (set-marker (nth posto attr-value) from)
336 (setcdr (nthcdr (1- posfrom) attr-value)
337 (cons (set-marker-type (set-marker (make-marker)
340 (cons (set-marker-type
341 (set-marker (make-marker)
344 (nthcdr posto attr-value))))
345 (setcar attr-value (+ len 2))))
346 (if (= (% posfrom 2) 0)
347 (setq posfrom (1- posfrom))
348 (set-marker (nth posfrom attr-value) from))
349 (if (= (% posto 2) 0)
351 (setq posto (1- posto))
352 (set-marker (nth posto attr-value) to))
353 (setcdr (nthcdr posfrom attr-value)
354 (nthcdr posto attr-value)))))
356 (defalias 'make-overlay 'cons)
358 (defun overlay-put (overlay prop value)
359 (let ((ret (and (eq prop 'face)
360 (assq value emu:available-face-attribute-alist))))
362 (attribute-add-narrow-attribute (cdr ret)
363 (car overlay)(cdr overlay))))))
365 (defun make-overlay (beg end &optional buffer type))
366 (defun overlay-put (overlay prop value))))
368 (defun overlay-buffer (overlay))
374 (defun-maybe generate-new-buffer-name (name &optional ignore)
375 "Return a string that is the name of no existing buffer based on NAME.
376 If there is no live buffer named NAME, then return NAME.
377 Otherwise modify name by appending `<NUMBER>', incrementing NUMBER
378 until an unused name is found, and then return that name.
379 Optional second argument IGNORE specifies a name that is okay to use
380 \(if it is in the sequence to be tried)
381 even if a buffer with that name exists."
382 (if (get-buffer name)
384 (while (get-buffer (setq new (format "%s<%d>" name n)))
389 (or (fboundp 'si:mark)
390 (fset 'si:mark (symbol-function 'mark)))
391 (defun mark (&optional force)
398 ;;; poe-18.el ends here