;; -*- mode: emacs-lisp -*-

;; $Id: emacs-standard,v 1.3 2002/09/26 10:24:22 tfheen Exp $
(require 'cl)

(defmacro cw/for-emacs-20 (&rest body)
  `(when (= emacs-major-version 20)
     ,@body))

(defmacro cw/for-emacs-21 (&rest body)
  `(when (and (= emacs-major-version 21) 
              (not (string-match "Lucid" emacs-version)))
     ,@body))

(defmacro cw/for-emacs-21-and-later (&rest body)
  `(when (and (>= emacs-major-version 21) 
              (not (string-match "Lucid" emacs-version)))
     ,@body))

(defmacro cw/for-emacs-22 (&rest body)
  `(when (and (= emacs-major-version 22) 
              (not (string-match "Lucid" emacs-version)))
     ,@body))

(defmacro cw/for-emacs-22-and-later (&rest body)
  `(when (and (>= emacs-major-version 22)
	      (not (string-match "Lucid" emacs-version)))
     ,@body))

(defmacro cw/for-emacs-23 (&rest body)
  `(when (and (= emacs-major-version 23) 
              (not (string-match "Lucid" emacs-version)))
     ,@body))

(defmacro cw/for-emacs-23-and-later (&rest body)
  `(when (and (>= emacs-major-version 23)
	      (not (string-match "Lucid" emacs-version)))
     ,@body))

(defmacro cw/for-emacs (&rest body)
  `(when (not (string-match "Lucid" emacs-version))
     ,@body))

(defmacro cw/for-xemacs-21 (&rest body)
  `(when (and (>= emacs-major-version 21) 
              (string-match "Lucid" emacs-version))
     ,@body))

(defmacro cw/not-for-host (host &rest body)
  `(when (not (string-match ,host system-name))
     ,@body))

(defmacro cw/for-host (host &rest body)
  `(when (string-match ,host system-name)
     ,@body))
(put 'cw/for-host 'lisp-indent-function 1)

(defun cw/elide-string (str max end-percent)
  "If STR is longer then MAX, return an elided version of STR.
END-PERCENT says what percentage of the string should follow the
ellipsis.
MAX should be greater than five."
  (let* ((len (length str))
 (end-len (- (floor (* max end-percent)) 1))
 (beg-len (- (- max end-len) 2)))
    (if (or (< len max)
    ;; If it would basically be entirely ellipsis, just return
    ;; the string as is.
    (< len 5)
    (and (> len max) (< len end-len)))
str
      (concat (substring str 0 beg-len)
      "..."
      (substring str beg-len (+ beg-len end-len))))))

(defvar cw/load-errors-p nil
  "Whether or not there were errors loading on startup.")

(defmacro* cw/requiring-package ((package &key error-if-fail) &rest forms)
  `(catch 'cw/requiring-package-fail
     (progn
       (condition-case nil
   (require ',package)
 (error
  (let ((msg (format  "Failed to load package %s "
      (symbol-name ',package))))
    (setq cw/load-errors-p t)
    (with-current-buffer (get-buffer-create "*Load log*")
      (insert msg  "\n"))
    (if ,error-if-fail
(error msg)
      (throw 'cw/requiring-package-fail nil)))))
       ,@forms)))

(put 'cw/requiring-package 'lisp-indent-function 1)

(defmacro* cw/requiring-forms ((&key error-if-fail) &rest forms)
  (let ((formsym (gensym "--cw/requiring-forms--")))
    `(let ((,formsym ',forms))
       (condition-case nil
   (progn ,@forms)
 (error
  (setq cw/load-errors-p t)
  (let ((msg (concat  "Failed to eval forms: "
      (cw/elide-string (format "%s" ,formsym)
       50 .2))))
    (with-current-buffer (get-buffer-create "*Load log*")
      (insert msg  "\n"))
    (when ,error-if-fail
      (error msg))))))))
(put 'cw/requiring-forms 'lisp-indent-function 1)

(defun cw/maybe-display-package-errors ()
  (if cw/load-errors-p
      (progn
(setq inhibit-startup-message t)
(pop-to-buffer "*Load log*")
(sit-for 1))
    (message "No package loading errors")))

(defmacro cw/case-with-test (testfn item &rest tests)
  (let ((itsym (gensym "--case-string=")))
    `(let ((,itsym ,item))
       (cond
,@(mapcar
   #'(lambda (test)
       (cons (if (consp (car test))
 (cons 'or
       (mapcar #'(lambda (item)
   (list testfn itsym item)) (car test)))
       (list testfn itsym (car test)))
     (cdr test)))
   tests)))))

(defun modify-alist (alist-symbol key value &optional search-cdr test)
  (let ((alist (symbol-value alist-symbol)))
    (while alist
      (if (funcall (if test test #'eq)
   (if search-cdr
       (cdr (car alist))
     (car (car alist))) key)
  (setcdr (car alist) value))
      (setq alist (cdr alist)))))

; Various functions

(defun dos-to-unix () 
  (interactive)
  (save-excursion
    (goto-char (point-min))
    (replace-string "‘" "æ")
    (replace-string "›" "ø")
    (replace-string "†" "å")
    (replace-string "’" "Æ")
    (replace-string "" "Ø")
    (replace-string "" "Å")
    (replace-string "
" "")
    (replace-string "" "")))

(defun text-to-html () 
  (interactive)
  (save-excursion
    (goto-char (point-min))
    (replace-string "æ" "&aelig;")
    (replace-string "æ" "&oslash;")
    (replace-string "å" "&aring;")
    (replace-string "Æ" "&AElig;")
    (replace-string "Ø" "&Oslash;")
    (replace-string "Å" "&Aring;")))