;; 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.
(setq lyear (and (zerop (% yyyy 4))
(or (not (zerop (% yyyy 100)))
(zerop (% yyyy 400)))))
- (while (> (- dd (nth mm mdays)) 0)
- (if (and (= mm 1) lyear)
- (setq dd (- dd 29))
- (setq dd (- dd (nth mm mdays))))
+ (while (> (- dd (if (and lyear (= mm 1)) 29 (nth mm mdays))) 0)
+ (setq dd (- dd (if (and lyear (= mm 1)) 29 (nth mm mdays))))
(setq mm (1+ mm)))
(setq HH (/ low 3600)
low (% low 3600)
;;; @@ 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 buffer-undo-list nil)
-(defvar-maybe auto-fill-function nil)
-(defvar-maybe unread-command-event nil)
-(defvar-maybe unread-command-events nil)
+(defvar-maybe buffer-undo-list nil
+ "List of undo entries in current buffer.
+APEL provides this as dummy for a compatibility.")
+
+(defvar-maybe auto-fill-function nil
+ "Function called (if non-nil) to perform auto-fill.
+APEL provides this as dummy for a compatibility.")
+
+(defvar-maybe unread-command-event nil
+ "APEL provides this as dummy for a compatibility.")
+(defvar-maybe unread-command-events nil
+ "List of events to be read as the command input.
+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 minor-mode-map-alist nil
+ "Alist of keymaps to use for minor modes.
+APEL provides this as dummy for a compatibility.")
-(defalias 'buffer-disable-undo 'buffer-flush-undo)
(defalias 'insert-and-inherit 'insert)
(defalias 'insert-before-markers-and-inherit 'insert-before-markers)
(defalias 'number-to-string 'int-to-string)
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."
+Fifth arg HIST is ignored in this implementation."
(si:read-from-minibuffer prompt initial-contents keymap read))))
;; Add optional argument `frame'.
(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)
+ "Cycle through all visible windows, calling PROC for each one.
+PROC is called with a window as argument.
+
+Optional second arg MINIBUF t means count the minibuffer window even
+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 argument ALL-FRAMES is ignored in this implementation."
+ (if (window-minibuffer-p (selected-window))
+ (setq minibuf t))
+ (let* ((walk-windows-start (selected-window))
+ (walk-windows-current walk-windows-start))
+ (unwind-protect
+ (while (progn
+ (setq walk-windows-current
+ (next-window walk-windows-current minibuf))
+ (funcall proc walk-windows-current)
+ (not (eq walk-windows-current walk-windows-start))))
+ (select-window walk-windows-start))))
+
+(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))))
+
+
+;;; @@ Frame (Emacs 18 cannot make 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-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."
+ (screen-width))
+
+(defun frame-height (&optional frame)
+ "Return number of lines available for display on FRAME.
+If FRAME is omitted, describe the currently selected frame."
+ (screen-height))
+
+(defun set-frame-width (frame cols &optional pretend)
+ "Specify that the frame FRAME has COLS columns.
+Optional third arg non-nil means that redisplay should use COLS columns
+but that the idea of the actual width of the frame should not be changed."
+ (set-screen-width cols 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-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)
projects / elisp / apel.git / blobdiff