;;; 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 <tomo@m17n.org>
;; Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
;; 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:
;; 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)
;;
;; 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
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)))
\f
;;; @ Window commands emulation. (lisp/window.el)
(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),
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))
- ;; 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.
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.
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))
- (file-already-exists t))
- ;; the dir was somehow created by someone else
- ;; between `make-temp-name' and `make-directory',
- ;; let's try again.
- )
- dir)
- ;; Create a temporary 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))
- (file-already-exists t))
- ;; let's try again.
- )
- ;; 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))
- (file-already-exists t))
- ;; let's try again.
- )
- 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))))))
+ (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)))))))))))
;; Actually, `path-separator' is defined in src/emacs.c and overrided
;; in dos-w32.el.
projects / elisp / apel.git / blobdiff