poe.el

   1 ;;; poe.el --- Portable Outfit for Emacsen; -*-byte-compile-dynamic: t;-*-
   2
   3 ;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
   4
   5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   6 ;; Keywords: emulation, compatibility, NEmacs, MULE, Emacs/mule, XEmacs
   7
   8 ;; This file is part of APEL (A Portable Emacs Library).
   9
  10 ;; This program is free software; you can redistribute it and/or
  11 ;; modify it under the terms of the GNU General Public License as
  12 ;; published by the Free Software Foundation; either version 2, or (at
  13 ;; your option) any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful, but
  16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18 ;; General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; This modules does not includes MULE related features.  MULE related
  28 ;; features are supported by `poem'.
  29
  30 ;;; Code:
  31
  32 (defmacro defun-maybe (name &rest everything-else)
  33   (or (and (fboundp name)
  34            (not (get name 'defun-maybe)))
  35       (` (or (fboundp (quote (, name)))
  36              (progn
  37                (defun (, name) (,@ everything-else))
  38                (put (quote (, name)) 'defun-maybe t)
  39                ))
  40          )))
  41
  42 (defmacro defsubst-maybe (name &rest everything-else)
  43   (or (and (fboundp name)
  44            (not (get name 'defsubst-maybe)))
  45       (` (or (fboundp (quote (, name)))
  46              (progn
  47                (defsubst (, name) (,@ everything-else))
  48                (put (quote (, name)) 'defsubst-maybe t)
  49                ))
  50          )))
  51
  52 (defmacro defmacro-maybe (name &rest everything-else)
  53   (or (and (fboundp name)
  54            (not (get name 'defmacro-maybe)))
  55       (` (or (fboundp (quote (, name)))
  56              (progn
  57                (defmacro (, name) (,@ everything-else))
  58                (put (quote (, name)) 'defmacro-maybe t)
  59                ))
  60          )))
  61
  62 (defmacro defalias-maybe (symbol definition)
  63   (setq symbol (eval symbol))
  64   (or (and (fboundp symbol)
  65            (not (get symbol 'defalias-maybe)))
  66       (` (or (fboundp (quote (, symbol)))
  67              (progn
  68                (defalias (quote (, symbol)) (, definition))
  69                (put (quote (, symbol)) 'defalias-maybe t)
  70                ))
  71          )))
  72
  73 (put 'defun-maybe 'lisp-indent-function 'defun)
  74 (put 'defsubst-maybe 'lisp-indent-function 'defun)
  75 (put 'defmacro-maybe 'lisp-indent-function 'defun)
  76
  77 (defmacro defvar-maybe (name &rest everything-else)
  78   (or (and (boundp name)
  79            (not (get name 'defvar-maybe)))
  80       (` (or (boundp (quote (, name)))
  81              (progn
  82                (defvar (, name) (,@ everything-else))
  83                (put (quote (, name)) 'defvar-maybe t)
  84                ))
  85          )))
  86
  87 (defmacro defconst-maybe (name &rest everything-else)
  88   (or (and (boundp name)
  89            (not (get name 'defconst-maybe))
  90            )
  91       (` (or (boundp (quote (, name)))
  92              (progn
  93                (defconst (, name) (,@ everything-else))
  94                (put (quote (, name)) 'defconst-maybe t)
  95                ))
  96          )))
  97
  98 (defconst-maybe emacs-major-version (string-to-int emacs-version))
  99 (defconst-maybe emacs-minor-version
 100   (string-to-int
 101    (substring emacs-version
 102               (string-match (format "%d\\." emacs-major-version)
 103                             emacs-version))))
 104
 105 (cond ((featurep 'xemacs)
 106        (require 'poe-xemacs)
 107        )
 108       ((string-match "XEmacs" emacs-version)
 109        (provide 'xemacs)
 110        (require 'poe-xemacs)
 111        )
 112       ((> emacs-major-version 20))
 113       ((= emacs-major-version 20)
 114        (cond ((fboundp 'string)
 115               ;; Emacs 20.3 or later
 116               )
 117              ((fboundp 'concat-chars)
 118               ;; Emacs 20.1 or later
 119               (defalias 'string 'concat-chars)
 120               ))
 121        )
 122       ((= emacs-major-version 19))
 123       (t
 124        (require 'poe-18)
 125        ))
 126
 127
 128 ;;; @ Emacs 19 emulation
 129 ;;;
 130
 131 (defmacro-maybe eval-and-compile (&rest body)
 132   "Like `progn', but evaluates the body at compile time and at load time."
 133   ;; Remember, it's magic.
 134   (cons 'progn body))
 135
 136 (defun-maybe minibuffer-prompt-width ()
 137   "Return the display width of the minibuffer prompt."
 138   (save-excursion
 139     (set-buffer (window-buffer (minibuffer-window)))
 140     (current-column)))
 141
 142
 143 ;;; @ Emacs 19.29 emulation
 144 ;;;
 145
 146 (defvar path-separator ":"
 147   "Character used to separate concatenated paths.")
 148
 149 (defun-maybe buffer-substring-no-properties (start end)
 150   "Return the characters of part of the buffer, without the text properties.
 151 The two arguments START and END are character positions;
 152 they can be in either order. [Emacs 19.29 emulating function]"
 153   (let ((string (buffer-substring start end)))
 154     (set-text-properties 0 (length string) nil string)
 155     string))
 156
 157 (defun-maybe match-string (num &optional string)
 158   "Return string of text matched by last search.
 159 NUM specifies which parenthesized expression in the last regexp.
 160  Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
 161 Zero means the entire text matched by the whole regexp or whole string.
 162 STRING should be given if the last search was by `string-match' on STRING.
 163 \[Emacs 19.29 emulating function]"
 164   (if (match-beginning num)
 165       (if string
 166           (substring string (match-beginning num) (match-end num))
 167         (buffer-substring (match-beginning num) (match-end num)))))
 168
 169 (or (featurep 'xemacs)
 170     (>= emacs-major-version 20)
 171     (and (= emacs-major-version 19)
 172          (>= emacs-minor-version 29))
 173     ;; for Emacs 19.28 or earlier
 174     (fboundp 'si:read-string)
 175     (eval-and-compile
 176       (fset 'si:read-string (symbol-function 'read-string))
 177       (defun read-string (prompt &optional initial-input history)
 178         "Read a string from the minibuffer, prompting with string PROMPT.
 179 If non-nil, second arg INITIAL-INPUT is a string to insert before reading.
 180 The third arg HISTORY, is dummy for compatibility.
 181 See `read-from-minibuffer' for details of HISTORY argument."
 182         (si:read-string prompt initial-input))
 183       ))
 184
 185 (defmacro-maybe make-local-hook (hook))
 186
 187 ;; They are not Emacs features
 188
 189 (defmacro-maybe add-local-hook (hook function &optional append)
 190   (if (fboundp 'make-local-hook)
 191       (list 'add-hook hook function append 'local)
 192     (list 'add-hook hook function append)
 193     ))
 194
 195 (defmacro remove-local-hook (hook function)
 196   (if (fboundp 'make-local-hook)
 197       (list 'remove-hook hook function 'local)
 198     (list 'remove-hook hook function)
 199     ))
 200
 201
 202 ;;; @ Emacs 19.30 emulation
 203 ;;;
 204
 205 ;; imported from Emacs 19.30.
 206 (defun-maybe add-to-list (list-var element)
 207   "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet.
 208 If you want to use `add-to-list' on a variable that is not defined
 209 until a certain package is loaded, you should put the call to `add-to-list'
 210 into a hook function that will be run only after loading the package.
 211 \[Emacs 19.30 emulating function]"
 212   (or (member element (symbol-value list-var))
 213       (set list-var (cons element (symbol-value list-var)))))
 214
 215 (cond ((fboundp 'insert-file-contents-literally))
 216       ((boundp 'file-name-handler-alist)
 217        (defun insert-file-contents-literally
 218          (filename &optional visit beg end replace)
 219          "Like `insert-file-contents', q.v., but only reads in the file.
 220 A buffer may be modified in several ways after reading into the buffer due
 221 to advanced Emacs features, such as file-name-handlers, format decoding,
 222 find-file-hooks, etc.
 223   This function ensures that none of these modifications will take place.
 224 \[Emacs 19.30 emulating function]"
 225          (let (file-name-handler-alist)
 226            (insert-file-contents filename visit beg end replace)))
 227        )
 228       (t
 229        (defalias 'insert-file-contents-literally 'insert-file-contents)
 230        ))
 231
 232
 233 ;;; @ Emacs 19.31 emulation
 234 ;;;
 235
 236 (defun-maybe buffer-live-p (object)
 237   "Return non-nil if OBJECT is a buffer which has not been killed.
 238 Value is nil if OBJECT is not a buffer or if it has been killed.
 239 \[Emacs 19.31 emulating function]"
 240   (and object
 241        (get-buffer object)
 242        (buffer-name (get-buffer object))))
 243
 244 ;; imported from Emacs 19.33.
 245 (defmacro-maybe save-selected-window (&rest body)
 246   "Execute BODY, then select the window that was selected before BODY.
 247 \[Emacs 19.31 emulating function]"
 248   (list 'let
 249         '((save-selected-window-window (selected-window)))
 250         (list 'unwind-protect
 251               (cons 'progn body)
 252               (list 'select-window 'save-selected-window-window))))
 253
 254
 255 ;;; @ Emacs 20.1 emulation
 256 ;;;
 257
 258 ;; imported from Emacs 20.2.
 259 (defmacro-maybe when (cond &rest body)
 260   "(when COND BODY...): if COND yields non-nil, do BODY, else return nil."
 261   (list 'if cond (cons 'progn body)))
 262
 263 ;; imported from Emacs 20.3.
 264 (defmacro-maybe unless (cond &rest body)
 265   "(unless COND BODY...): if COND yields nil, do BODY, else return nil."
 266   (cons 'if (cons cond (cons nil body))))
 267
 268 (defmacro-maybe save-current-buffer (&rest body)
 269   "Save the current buffer; execute BODY; restore the current buffer.
 270 Executes BODY just like `progn'."
 271   (` (let ((orig-buffer (current-buffer)))
 272        (unwind-protect
 273            (progn (,@ body))
 274          (set-buffer orig-buffer)))))
 275
 276 ;; imported from Emacs 20.2.
 277 (defmacro-maybe with-current-buffer (buffer &rest body)
 278   "Execute the forms in BODY with BUFFER as the current buffer.
 279 The value returned is the value of the last form in BODY.
 280 See also `with-temp-buffer'."
 281   (` (save-current-buffer
 282        (set-buffer (, buffer))
 283        (,@ body))))
 284
 285 ;; imported from Emacs 20.2.
 286 (defmacro-maybe with-temp-file (file &rest forms)
 287   "Create a new buffer, evaluate FORMS there, and write the buffer to FILE.
 288 The value of the last form in FORMS is returned, like `progn'.
 289 See also `with-temp-buffer'."
 290   (let ((temp-file (make-symbol "temp-file"))
 291         (temp-buffer (make-symbol "temp-buffer")))
 292     (` (let (((, temp-file) (, file))
 293              ((, temp-buffer)
 294               (get-buffer-create (generate-new-buffer-name " *temp file*"))))
 295          (unwind-protect
 296              (prog1
 297                  (with-current-buffer (, temp-buffer)
 298                    (,@ forms))
 299                (with-current-buffer (, temp-buffer)
 300                  (widen)
 301                  (write-region (point-min) (point-max) (, temp-file) nil 0)))
 302            (and (buffer-name (, temp-buffer))
 303                 (kill-buffer (, temp-buffer))))))))
 304
 305 ;; imported from Emacs 20.2.
 306 (defmacro-maybe with-temp-buffer (&rest forms)
 307   "Create a temporary buffer, and evaluate FORMS there like `progn'.
 308 See also `with-temp-file' and `with-output-to-string'."
 309   (let ((temp-buffer (make-symbol "temp-buffer")))
 310     (` (let (((, temp-buffer)
 311               (get-buffer-create (generate-new-buffer-name " *temp*"))))
 312          (unwind-protect
 313              (with-current-buffer (, temp-buffer)
 314                (,@ forms))
 315            (and (buffer-name (, temp-buffer))
 316                 (kill-buffer (, temp-buffer))))))))
 317
 318 ;; imported from Emacs 20.3.
 319 (defun-maybe last (x &optional n)
 320   "Return the last link of the list X.  Its car is the last element.
 321 If X is nil, return nil.
 322 If N is non-nil, return the Nth-to-last link of X.
 323 If N is bigger than the length of X, return X."
 324   (if n
 325       (let ((m 0) (p x))
 326         (while (consp p)
 327           (setq m (1+ m) p (cdr p)))
 328         (if (<= n 0) p
 329           (if (< n m) (nthcdr (- m n) x) x)))
 330     (while (cdr x)
 331       (setq x (cdr x)))
 332     x))
 333
 334 ;; imported from Emacs 20.3. (cl function)
 335 (defun-maybe butlast (x &optional n)
 336   "Returns a copy of LIST with the last N elements removed."
 337   (if (and n (<= n 0)) x
 338     (nbutlast (copy-sequence x) n)))
 339
 340 ;; imported from Emacs 20.3. (cl function)
 341 (defun-maybe nbutlast (x &optional n)
 342   "Modifies LIST to remove the last N elements."
 343   (let ((m (length x)))
 344     (or n (setq n 1))
 345     (and (< n m)
 346          (progn
 347            (if (> n 0) (setcdr (nthcdr (- (1- m) n) x) nil))
 348            x))))
 349
 350 ;; imported from XEmacs 21.
 351 (defun-maybe split-string (string &optional pattern)
 352   "Return a list of substrings of STRING which are separated by PATTERN.
 353 If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
 354   (or pattern
 355       (setq pattern "[ \f\t\n\r\v]+"))
 356   ;; The FSF version of this function takes care not to cons in case
 357   ;; of infloop.  Maybe we should synch?
 358   (let (parts (start 0))
 359     (while (string-match pattern string start)
 360       (setq parts (cons (substring string start (match-beginning 0)) parts)
 361             start (match-end 0)))
 362     (nreverse (cons (substring string start) parts))))
 363
 364
 365 ;;; @ Emacs 20.3 emulation
 366 ;;;
 367
 368 ;; imported from Emacs 20.3.91.
 369 (defvar-maybe temporary-file-directory
 370   (file-name-as-directory
 371    (cond ((memq system-type '(ms-dos windows-nt))
 372           (or (getenv "TEMP") (getenv "TMPDIR") (getenv "TMP") "c:/temp"))
 373          ((memq system-type '(vax-vms axp-vms))
 374           (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "SYS$SCRATCH:"))
 375          (t
 376           (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp"))))
 377   "The directory for writing temporary files.")
 378
 379 (defun-maybe line-beginning-position (&optional n)
 380   "Return the character position of the first character on the current line.
 381 With argument N not nil or 1, move forward N - 1 lines first.
 382 If scan reaches end of buffer, return that position.
 383 This function does not move point."
 384   (save-excursion
 385     (if n
 386         (forward-line (1- n))
 387       )
 388     (beginning-of-line)
 389     (point)))
 390
 391 (defun-maybe line-end-position (&optional n)
 392   "Return the character position of the last character on the current line.
 393 With argument N not nil or 1, move forward N - 1 lines first.
 394 If scan reaches end of buffer, return that position.
 395 This function does not move point."
 396   (save-excursion
 397     (if n
 398         (forward-line (1- n))
 399       )
 400     (end-of-line)
 401     (point)))
 402
 403 (defun-maybe string (&rest chars)
 404   "Concatenate all the argument characters and make the result a string."
 405   (mapconcat (function char-to-string) chars "")
 406   )
 407
 408
 409 ;;; @ XEmacs emulation
 410 ;;;
 411
 412 (defun-maybe find-face (face-or-name)
 413   "Retrieve the face of the given name.
 414 If FACE-OR-NAME is a face object, it is simply returned.
 415 Otherwise, FACE-OR-NAME should be a symbol.  If there is no such face,
 416 nil is returned.  Otherwise the associated face object is returned.
 417 \[XEmacs emulating function]"
 418   (car (memq face-or-name (face-list)))
 419   )
 420
 421 (defun-maybe point-at-bol (&optional n buffer)
 422   "Return the character position of the first character on the current line.
 423 With argument N not nil or 1, move forward N - 1 lines first.
 424 If scan reaches end of buffer, return that position.
 425 This function does not move point. [XEmacs emulating function]"
 426   (save-excursion
 427     (if buffer
 428         (set-buffer buffer)
 429       )
 430     (line-beginning-position n)
 431     ))
 432
 433 (defun-maybe point-at-eol (&optional n buffer)
 434   "Return the character position of the last character on the current line.
 435 With argument N not nil or 1, move forward N - 1 lines first.
 436 If scan reaches end of buffer, return that position.
 437 This function does not move point. [XEmacs emulating function]"
 438   (save-excursion
 439     (if buffer
 440         (set-buffer buffer)
 441       )
 442     (line-end-position n)
 443     ))
 444
 445 (defun-maybe functionp (obj)
 446   "Returns t if OBJ is a function, nil otherwise.
 447 \[XEmacs emulating function]"
 448   (or (subrp obj)
 449       (byte-code-function-p obj)
 450       (and (symbolp obj)(fboundp obj))
 451       (and (consp obj)(eq (car obj) 'lambda))
 452       ))
 453
 454 (defsubst-maybe define-obsolete-function-alias (oldfun newfun)
 455   "Define OLDFUN as an obsolete alias for function NEWFUN.
 456 This makes calling OLDFUN equivalent to calling NEWFUN and marks OLDFUN
 457 as obsolete. [XEmacs emulating function]"
 458   (defalias oldfun newfun)
 459   (make-obsolete oldfun newfun)
 460   )
 461
 462
 463 ;;; @ end
 464 ;;;
 465
 466 (provide 'poe)
 467
 468 ;;; poe.el ends here