;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; @ Compilation.
;;;
-(fset 'defalias 'fset)
+(defun defalias (sym newdef)
+ "Set SYMBOL's function definition to NEWVAL, and return NEWVAL."
+ (fset sym newdef))
(defun byte-code-function-p (object)
"Return t if OBJECT is a byte-compiled function object."
("GMT-8" . -800)("GMT-9" . -900)("GMT-10" . -1000)
("GMT-11" . -1100) ("GMT-12" . -1200))
"Time differentials of timezone from GMT in +-HHMM form.
-Used in `current-time-zone' (Emacs 19 emulating function in poe-18.el).")
+Used in `current-time-zone' (Emacs 19 emulating function by APEL).")
(defvar current-time-local-timezone nil
"*Local timezone name.
-Used in `current-time-zone' (Emacs 19 emulating function in poe-18.el).")
+Used in `current-time-zone' (Emacs 19 emulating function by APEL).")
(defun set-time-zone-rule (tz)
"Set the local time zone using TZ, a string specifying a time zone rule.
;;; @@ Floating point numbers.
;;;
-(defalias 'numberp 'integerp)
-
(defun abs (arg)
"Return the absolute value of ARG."
(if (< arg 0) (- arg) arg))
-(defun floor (arg &optional divisor)
- "Return the largest integer no grater than ARG.
-With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR."
- (if (null divisor)
- (setq divisor 1))
- (if (< arg 0)
- (- (/ (- divisor 1 arg) divisor))
- (/ arg divisor)))
-
-(defalias 'mod '%)
-
;;; @ Basic lisp subroutines.
;;;
;; 18.55 does not have these variables.
(defvar-maybe buffer-undo-list nil
"List of undo entries in current buffer.
-poe-18.el provides this as dummy for a compatibility.")
+APEL provides this as dummy for a compatibility.")
(defvar-maybe auto-fill-function nil
"Function called (if non-nil) to perform auto-fill.
-poe-18.el provides this as dummy for a compatibility.")
+APEL provides this as dummy for a compatibility.")
(defvar-maybe unread-command-event nil
- "poe-18.el provides this as dummy for a compatibility.")
+ "APEL provides this as dummy for a compatibility.")
(defvar-maybe unread-command-events nil
"List of events to be read as the command input.
-poe-18.el provides this as dummy for a compatibility.")
+APEL provides this as dummy for a compatibility.")
-(defvar-maybe minibuffer-setup-hook nil
- "Normal hook run just after entry to minibuffer.")
-(defvar-maybe minibuffer-exit-hook nil
- "Normal hook run just after exit from minibuffer.")
+;; (defvar-maybe minibuffer-setup-hook nil
+;; "Normal hook run just after entry to minibuffer.")
+;; (defvar-maybe minibuffer-exit-hook nil
+;; "Normal hook run just after exit from minibuffer.")
(defvar-maybe minor-mode-map-alist nil
"Alist of keymaps to use for minor modes.
-poe-18.el provides this as dummy for a compatibility.")
-(defvar-maybe minor-mode-alist nil
- "Alist saying how to show minor modes in the mode line.
-poe-18.el provides this as dummy for a compatibility.")
-(defvar-maybe minor-mode-overriding-map-alist nil
- "Alist of keymaps to use for minor modes, in current major mode.
-poe-18.el provides this as dummy for a compatibility.")
+APEL provides this as dummy for a compatibility.")
(defalias 'insert-and-inherit 'insert)
(defalias 'insert-before-markers-and-inherit 'insert-before-markers)
If fourth arg READ is non-nil, then interpret the result as a lisp object
and return that object:
in other words, do `(car (read-from-string INPUT-STRING))'
-Fifth arg HIST is ignored in this implementatin."
- (with-current-buffer
- (get-buffer-create
- (format " *Minibuf-%d*" (minibuffer-depth)))
- (run-hooks 'minibuffer-setup-hook))
- (si:read-from-minibuffer prompt initial-contents keymap read)
- (with-current-buffer
- (get-buffer-create
- (format " *Minibuf-%d*" (minibuffer-depth)))
- (condition-case nil
- (run-hooks 'minibuffer-exit-hook)
- (error))))))
+Fifth arg HIST is ignored in this implementation."
+ (si:read-from-minibuffer prompt initial-contents keymap read))))
;; Add optional argument `frame'.
(or (fboundp 'si:get-buffer-window)
(fset 'si:get-buffer-window (symbol-function 'get-buffer-window))
(defun get-buffer-window (buffer &optional frame)
"Return a window currently displaying BUFFER, or nil if none.
-Optional argunemt FRAME is ignored in this implementation."
+Optional argument FRAME is ignored in this implementation."
(si:get-buffer-window buffer))))
(defun-maybe walk-windows (proc &optional minibuf all-frames)
if not active. MINIBUF nil or omitted means count the minibuffer iff
it is active. MINIBUF neither t nor nil means not to count the
minibuffer even if it is active.
-Optional third argunemt ALL-FRAMES is ignored in this implementation."
+Optional third argument ALL-FRAMES is ignored in this implementation."
(if (window-minibuffer-p (selected-window))
(setq minibuf t))
(let* ((walk-windows-start (selected-window))
(defun buffer-disable-undo (&optional buffer)
"Make BUFFER stop keeping undo information.
No argument or nil as argument means do this for the current buffer."
- (buffer-flush-undo (or buffer (current-buffer))))
+ (buffer-flush-undo (or buffer (current-buffer))))
;;; @@ Frame (Emacs 18 cannot make frame)
;;;
-;; The following four are frequently used for manupulating the current frame.
+;; The following four are frequently used for manipulating the current frame.
;; frame.el has `screen-width', `screen-height', `set-screen-width' and
-;; `set-screen-heigth' for backward compatibility and declare them as obsolete.
+;; `set-screen-height' for backward compatibility and declare them as obsolete.
(defun frame-width (&optional frame)
"Return number of columns available for display on FRAME.
If FRAME is omitted, describe the currently selected frame."
but that the idea of the actual width of the frame should not be changed."
(set-screen-width cols pretend))
-(defun set-frame-heigth (frame cols &optional pretend)
+(defun set-frame-height (frame lines &optional pretend)
"Specify that the frame FRAME has LINES lines.
Optional third arg non-nil means that redisplay should use LINES lines
but that the idea of the actual height of the frame should not be changed."
- (set-screen-heigth cols pretend))
+ (set-screen-height lines pretend))
;;; @@ Environment variables.
;;;
(defun make-directory-internal (dirname)
"Create a directory. One argument, a file name string."
- (let ((dir (expand-file-name dirname)))
- (if (file-exists-p dir)
- (error "Creating directory: %s is already exist" dir)
- (call-process "mkdir" nil nil nil dir))))
+ (let ((dir (expand-file-name dirname)))
+ (if (file-exists-p dir)
+ (signal 'file-already-exists
+ (list "Creating directory: %s already exists" dir))
+ (let ((exit-status (call-process "mkdir" nil nil nil dir)))
+ (if (or (and (numberp exit-status)
+ (not (zerop exit-status)))
+ (stringp exit-status))
+ (error "Create directory %s failed.")
+ ;; `make-directory' of v19 and later returns nil for success.
+ )))))
(defun make-directory (dir &optional parents)
"Create the directory DIR and any nonexistent parent dirs.
(setq p p1)))
(make-directory-internal dir)))
+(defun delete-directory (directory)
+ "Delete the directory named DIRECTORY. Does not follow symlinks."
+ (let ((exit-status (call-process "rmdir" nil nil nil directory)))
+ (when (or (and (numberp exit-status) (not (zerop exit-status)))
+ (stringp exit-status))
+ (error "Delete directory %s failed."))))
+
(defun parse-colon-path (cd-path)
"Explode a colon-separated list of paths into a string list."
(and cd-path
If NOSORT is dummy for compatibility."
(si:directory-files directory full match))
+(or (fboundp 'si:write-region)
+ (fset 'si:write-region (symbol-function 'write-region)))
+(defun write-region (start end filename &optional append visit)
+ "Write current region into specified file.
+When called from a program, requires three arguments:
+START, END and FILENAME. START and END are normally buffer positions
+specifying the part of the buffer to write.
+If START is nil, that means to use the entire buffer contents.
+If START is a string, then output that string to the file
+instead of any buffer contents; END is ignored.
+
+Optional fourth argument APPEND if non-nil means
+ append to existing file contents (if any). If it is an integer,
+ seek to that offset in the file before writing.
+Optional fifth argument VISIT if t means
+ set the last-save-file-modtime of buffer to this file's modtime
+ and mark buffer not modified.
+If VISIT is a string, it is a second file name;
+ the output goes to FILENAME, but the buffer is marked as visiting VISIT.
+ VISIT is also the file name to lock and unlock for clash detection.
+If VISIT is neither t nor nil nor a string,
+ that means do not display the \"Wrote file\" message."
+ (cond
+ ((null start)
+ (si:write-region (point-min) (point-max) filename append visit))
+ ((stringp start)
+ (with-temp-buffer
+ (insert start)
+ (si:write-region (point-min) (point-max) filename append visit)))
+ (t
+ (si:write-region start end filename append visit))))
+
;;; @ Process.
;;;
(or (fboundp 'si:accept-process-output)