X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=poe-18.el;h=6dd2a904884ddcd9e29fe8fb1b0bd484370cdd4a;hb=7ac33fd4acbdd20e941426c25ee6ab4e086a9211;hp=bfdc0cd9f5546fa626935d3026766db954b2adea;hpb=4004f01ed820fe1be8811e14150812298ea26470;p=elisp%2Fapel.git diff --git a/poe-18.el b/poe-18.el index bfdc0cd..6dd2a90 100644 --- a/poe-18.el +++ b/poe-18.el @@ -50,7 +50,9 @@ ;;; @ 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." @@ -224,11 +226,11 @@ for this variable." ("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. @@ -450,23 +452,10 @@ resolution finer than a second." ;;; @@ 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. ;;; @@ -514,32 +503,26 @@ With optional non-nil ALL, force redisplay of all mode-lines." ;; 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) @@ -592,18 +575,8 @@ Third arg KEYMAP is a keymap to use whilst reading; 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) @@ -611,7 +584,7 @@ Fifth arg HIST is ignored in this implementatin." (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) @@ -622,7 +595,7 @@ 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 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)) @@ -638,14 +611,14 @@ Optional third argunemt ALL-FRAMES is ignored in this implementation." (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." @@ -662,11 +635,11 @@ 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-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. ;;; @@ -695,10 +668,17 @@ For a directory, this means you can access files in that directory." (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. @@ -722,6 +702,13 @@ to create parent directories if they don't exist." (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 @@ -760,6 +747,38 @@ If MATCH is non-nil, mention only file names that match the regexp MATCH. 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)