X-Git-Url: http://git.chise.org/gitweb/?p=elisp%2Fapel.git;a=blobdiff_plain;f=poe.el;h=0c7b4fff9db8aa2c1cdb61cb43e620df939401b2;hp=823160694c6cc9fe2709b1c78a8fce4cd12cf166;hb=8b0dbe5092ae30b5092d7abf96649f96635d1060;hpb=d3795aae8151bc26cccff0ceeeb8eb56172aa236 diff --git a/poe.el b/poe.el index 8231606..0c7b4ff 100644 --- a/poe.el +++ b/poe.el @@ -1,6 +1,7 @@ ;;; poe.el --- Portable Outfit for Emacsen -;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2005, +;; 2008 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Shuhei KOBAYASHI @@ -20,8 +21,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; 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: @@ -900,7 +901,7 @@ On other systems, this variable is normally always nil.") ;; Emacs 20.3 or later. (defvar-maybe minor-mode-overriding-map-alist nil "Alist of keymaps to use for minor modes, in current major mode. -APEL provides this as dummy for a compatibility.") +APEL provides this as dummy for compatibility.") ;; Emacs 20.1/XEmacs 20.3(?) and later: (save-current-buffer &rest BODY) ;; @@ -1484,7 +1485,7 @@ Not fully compatible especially when invalid format is specified." ;; Emacs 19.29-19.34/XEmacs: `format-time-string' neither supports the ;; format string "%z" nor the third argument `universal'. -(unless (string-match "\\`[\\-\\+][0-9]+\\'" +(unless (string-match "\\`[---+][0-9]+\\'" (format-time-string "%z" (current-time))) (defadvice format-time-string (before support-timezone-in-numeric-form-and-3rd-arg @@ -1523,20 +1524,62 @@ Not fully compatible especially when invalid format is specified." ls (- ls 65536)))) (setq time (append (list ms ls) (nth 2 time)))))))) -;; Emacs 20.1/XEmacs 20.3(?) and later: (split-string STRING &optional PATTERN) -;; Here is a XEmacs version. -(defun-maybe split-string (string &optional pattern) - "Return a list of substrings of STRING which are separated by PATTERN. -If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." - (or pattern - (setq pattern "[ \f\t\n\r\v]+")) - ;; The FSF version of this function takes care not to cons in case - ;; of infloop. Maybe we should synch? - (let (parts (start 0)) - (while (string-match pattern string start) - (setq parts (cons (substring string start (match-beginning 0)) parts) - start (match-end 0))) - (nreverse (cons (substring string start) parts)))) +(defconst-maybe split-string-default-separators "[ \f\t\n\r\v]+" + "The default value of separators for `split-string'. + +A regexp matching strings of whitespace. May be locale-dependent +\(as yet unimplemented). Should not match non-breaking spaces. + +Warning: binding this to a different value and using it as default is +likely to have undesired semantics.") + +;; Here is a Emacs 22 version. OMIT-NULLS +(defun-maybe split-string (string &optional separators omit-nulls) + "Split STRING into substrings bounded by matches for SEPARATORS. + +The beginning and end of STRING, and each match for SEPARATORS, are +splitting points. The substrings matching SEPARATORS are removed, and +the substrings between the splitting points are collected as a list, +which is returned. + +If SEPARATORS is non-nil, it should be a regular expression matching text +which separates, but is not part of, the substrings. If nil it defaults to +`split-string-default-separators', normally \"[ \\f\\t\\n\\r\\v]+\", and +OMIT-NULLS is forced to t. + +If OMIT-NULLS is t, zero-length substrings are omitted from the list \(so +that for the default value of SEPARATORS leading and trailing whitespace +are effectively trimmed). If nil, all zero-length substrings are retained, +which correctly parses CSV format, for example. + +Note that the effect of `(split-string STRING)' is the same as +`(split-string STRING split-string-default-separators t)'). In the rare +case that you wish to retain zero-length substrings when splitting on +whitespace, use `(split-string STRING split-string-default-separators)'. + +Modifies the match data; use `save-match-data' if necessary." + (let ((keep-nulls (not (if separators omit-nulls t))) + (rexp (or separators split-string-default-separators)) + (start 0) + notfirst + (list nil)) + (while (and (string-match rexp string + (if (and notfirst + (= start (match-beginning 0)) + (< start (length string))) + (1+ start) start)) + (< start (length string))) + (setq notfirst t) + (if (or keep-nulls (< start (match-beginning 0))) + (setq list + (cons (substring string start (match-beginning 0)) + list))) + (setq start (match-end 0))) + (if (or keep-nulls (< start (length string))) + (setq list + (cons (substring string start) + list))) + (nreverse list))) ;;; @ Window commands emulation. (lisp/window.el) @@ -1595,26 +1638,55 @@ See `walk-windows' for the meaning of MINIBUF and FRAME." (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp")))) "The directory for writing temporary files.") -;; Emacs 21: Create a temporary file. (lisp/subr.el) -;; Emacs 21.1-21.3 -;; (make-temp-file PREFIX &optional DIR-FLAG) -;; Emacs 21.3.x(?) and later +;; Emacs 21 CVS ; nothing to do. ;; (make-temp-file PREFIX &optional DIR-FLAG SUFFIX) -(static-condition-case nil - ;; compile-time check - (progn - (delete-file (make-temp-file "EMU" nil ".txt")) - (if (get 'make-temp-file 'defun-maybe) - (error "`make-temp-file' is already defined"))) - (wrong-number-of-arguments ; Emacs 21.1-21.3 - ;; load-time check. - ;; Replace original definition. - (or (fboundp 'si:make-temp-file) - (progn - (fset 'si:make-temp-file (symbol-function 'make-temp-file)) - (put 'make-temp-file 'defun-maybe t) - (defun make-temp-file (prefix &optional dir-flag suffix) - "\ +;; +;; Emacs 21.1-21.3 ; replace with CVS version of `make-temp-file'. +;; (make-temp-file PREFIX &optional DIR-FLAG) +;; +;; Emacs 20 and earlier ; install our version of `make-temp-file', for +;; or XEmacs ; single-user system or for multi-user system. +(eval-when-compile + (cond + ((get 'make-temp-file 'defun-maybe) + ;; this form is already evaluated during compilation. + ) + ((not (fboundp 'make-temp-file)) + ;; Emacs 20 and earlier, or XEmacs. + (put 'make-temp-file 'defun-maybe 'none)) + (t + (let* ((object (symbol-function 'make-temp-file)) + (arglist (cond + ((byte-code-function-p object) + (if (fboundp 'compiled-function-arglist) + (compiled-function-arglist object) + (aref object 0))) + ((eq (car-safe object) 'lambda) + (nth 1 object)) + ;; `make-temp-file' is a built-in. + ))) + ;; arglist: (prefix &optional dir-flag suffix) + (cond + ((not arglist) + ;; `make-temp-file' is a built-in; expects 3-args. + (put 'make-temp-file 'defun-maybe '3-args)) + ((> (length arglist) 3) + ;; Emacs 21 CVS. + (put 'make-temp-file 'defun-maybe '3-args)) + (t + ;; Emacs 21.1-21.3 + (put 'make-temp-file 'defun-maybe '2-args))))))) + +(static-cond + ((eq (get 'make-temp-file 'defun-maybe) '3-args) + (put 'make-temp-file 'defun-maybe '3-args)) + ((eq (get 'make-temp-file 'defun-maybe) '2-args) + (put 'make-temp-file 'defun-maybe '2-args) + (or (fboundp 'si:make-temp-file) + (fset 'si:make-temp-file (symbol-function 'make-temp-file))) + (setq current-load-list (cons 'make-temp-file current-load-list)) + (defun make-temp-file (prefix &optional dir-flag suffix) + "\ Create a temporary file. The returned file name (created by appending some random characters at the end of PREFIX, and expanding against `temporary-file-directory' if necessary), @@ -1624,46 +1696,43 @@ You can then use `write-region' to write new data into the file. If DIR-FLAG is non-nil, create a new empty directory instead of a file. If SUFFIX is non-nil, add that at the end of the file name." - (let ((umask (default-file-modes)) - file) - (unwind-protect - (progn - ;; Create temp files with strict access rights. - ;; It's easy toloosen them later, whereas it's impossible - ;; to close the time-window of loose permissions otherwise. - (set-default-file-modes ?\700) - (while (condition-case () - (progn - (setq file - (make-temp-name - (expand-file-name - prefix temporary-file-directory))) - (if suffix - (setq file (concat file suffix))) - (if dir-flag - (make-directory file) - (write-region "" nil file nil - 'silent nil 'excl)) - nil) - (file-already-exists t)) - ;; the file was somehow created by someone else between - ;; `make-temp-name' and `write-region', let's try again. - nil) - file) - ;; Reset the umask. - (set-default-file-modes umask)))) - ;; for `load-history'. - (setq current-load-list (cons 'make-temp-file current-load-list))))) - (error)) ; found our definition or no definition at compile-time. - -;; For the Emacsen which don't have make-temp-file. -(cond - ;; must be load-time check to share .elc between different systems. - ((fboundp 'make-temp-file)) - ((memq system-type '(windows-nt ms-dos OS/2 emx)) - ;; For single-user systems: - (defun-maybe make-temp-file (prefix &optional dir-flag suffix) - "Create a temporary file. + (let ((umask (default-file-modes)) + file) + (unwind-protect + (progn + ;; Create temp files with strict access rights. + ;; It's easy toloosen them later, whereas it's impossible + ;; to close the time-window of loose permissions otherwise. + (set-default-file-modes 448) + (while (condition-case () + (progn + (setq file + (make-temp-name + (expand-file-name + prefix temporary-file-directory))) + (if suffix + (setq file (concat file suffix))) + (if dir-flag + (make-directory file) + (write-region "" nil file nil + 'silent nil 'excl)) + nil) + (file-already-exists t)) + ;; the file was somehow created by someone else between + ;; `make-temp-name' and `write-region', let's try again. + nil) + file) + ;; Reset the umask. + (set-default-file-modes umask))))) + ((eq (get 'make-temp-file 'defun-maybe) 'none) + (put 'make-temp-file 'defun-maybe 'none) + (setq current-load-list (cons 'make-temp-file current-load-list)) + ;; must be load-time check to share .elc between different systems. + (cond + ((memq system-type '(windows-nt ms-dos OS/2 emx)) + ;; for single-user systems. + (defun make-temp-file (prefix &optional dir-flag suffix) + "Create a temporary file. The returned file name (created by appending some random characters at the end of PREFIX, and expanding against `temporary-file-directory' if necessary), is guaranteed to point to a newly created empty file. @@ -1672,17 +1741,18 @@ You can then use `write-region' to write new data into the file. If DIR-FLAG is non-nil, create a new empty directory instead of a file. If SUFFIX is non-nil, add that at the end of the file name." - (let ((file (make-temp-name (expand-file-name prefix - temporary-file-directory)))) - (if suffix - (setq file (concat file suffix))) - (if dir-flag - (make-directory file) - (write-region "" nil file nil 'silent)) - file))) - (t - (defun-maybe make-temp-file (prefix &optional dir-flag suffix) - "Create a temporary file. + (let ((file (make-temp-name + (expand-file-name prefix temporary-file-directory)))) + (if suffix + (setq file (concat file suffix))) + (if dir-flag + (make-directory file) + (write-region "" nil file nil 'silent)) + file))) + (t + ;; for multi-user systems. + (defun make-temp-file (prefix &optional dir-flag suffix) + "Create a temporary file. The returned file name (created by appending some random characters at the end of PREFIX, and expanding against `temporary-file-directory' if necessary), is guaranteed to point to a newly created empty file. @@ -1691,71 +1761,66 @@ You can then use `write-region' to write new data into the file. If DIR-FLAG is non-nil, create a new empty directory instead of a file. If SUFFIX is non-nil, add that at the end of the file name." - (let ((umask (default-file-modes))) - (unwind-protect - (let ((prefix (expand-file-name prefix temporary-file-directory))) - ;; Create temp files with strict access rights. It's easy to - ;; loosen them later, whereas it's impossible to close the - ;; time-window of loose permissions otherwise. - (set-default-file-modes 448) - (if dir-flag - ;; Create a new empty directory. - (let (dir) + (let ((prefix (expand-file-name prefix temporary-file-directory))) + (if dir-flag + ;; Create a new empty directory. + (let (dir) + (while (condition-case () + (progn + (setq dir (make-temp-name prefix)) + (if suffix + (setq dir (concat dir suffix))) + ;; `make-directory' returns nil for success, + ;; otherwise signals an error. + (make-directory dir)) + ;; the dir was somehow created by someone else + ;; between `make-temp-name' and `make-directory', + ;; let's try again. + (file-already-exists t))) + (set-file-modes dir 448) + dir) + ;; Create a new empty file. + (let (tempdir tempfile) + (unwind-protect + (let (file) + ;; First, create a temporary directory. (while (condition-case () (progn - (setq dir (make-temp-name prefix)) + (setq tempdir (make-temp-name + (concat + (file-name-directory prefix) + "DIR"))) + ;; return nil or signal an error. + (make-directory tempdir)) + ;; let's try again. + (file-already-exists t))) + (set-file-modes tempdir 448) + ;; Second, create a temporary file in the tempdir. + ;; There *is* a race condition between `make-temp-name' + ;; and `write-region', but we don't care it since we are + ;; in a private directory now. + (setq tempfile (make-temp-name (concat tempdir "/EMU"))) + (write-region "" nil tempfile nil 'silent) + (set-file-modes tempfile 384) + ;; Finally, make a hard-link from the tempfile. + (while (condition-case () + (progn + (setq file (make-temp-name prefix)) (if suffix - (setq dir (concat dir suffix))) - ;; `make-directory' returns nil for success, - ;; otherwise signals an error. - (make-directory dir)) - ;; the dir was somehow created by someone else - ;; between `make-temp-name' and `make-directory', + (setq file (concat file suffix))) + ;; return nil or signal an error. + (add-name-to-file tempfile file)) ;; let's try again. (file-already-exists t))) - dir) - ;; Create a new empty file. - (let (tempdir tempfile) - (unwind-protect - (let (file) - ;; First, create a temporary directory. - (while (condition-case () - (progn - (setq tempdir (make-temp-name - (concat - (file-name-directory prefix) - "DIR"))) - ;; return nil or signal an error. - (make-directory tempdir)) - ;; let's try again. - (file-already-exists t))) - ;; Second, create a temporary file in the tempdir. - ;; There *is* a race condition between `make-temp-name' - ;; and `write-region', but we don't care it since we are - ;; in a private directory now. - (setq tempfile (make-temp-name (concat tempdir "/EMU"))) - (write-region "" nil tempfile nil 'silent) - ;; Finally, make a hard-link from the tempfile. - (while (condition-case () - (progn - (setq file (make-temp-name prefix)) - (if suffix - (setq file (concat file suffix))) - ;; return nil or signal an error. - (add-name-to-file tempfile file)) - ;; let's try again. - (file-already-exists t))) - file) - ;; Cleanup the tempfile. - (and tempfile - (file-exists-p tempfile) - (delete-file tempfile)) - ;; Cleanup the tempdir. - (and tempdir - (file-directory-p tempdir) - (delete-directory tempdir)))))) - ;; Reset the umask. - (set-default-file-modes umask)))))) + file) + ;; Cleanup the tempfile. + (and tempfile + (file-exists-p tempfile) + (delete-file tempfile)) + ;; Cleanup the tempdir. + (and tempdir + (file-directory-p tempdir) + (delete-directory tempdir))))))))))) ;; Actually, `path-separator' is defined in src/emacs.c and overrided ;; in dos-w32.el.