;; various hacks
;; a compiled version exists!
;; Last edited: Thu Oct  2 16:47:40 1986

(provide 'misc)

(defun 
  insert-time ()
  (interactive)
  (insert-string (current-time-string)))

(global-set-key  "\et" 'insert-time)

(defun
  note-edit ()
  (interactive) 
  (beginning-of-buffer)
  (if 
      (not (search-forward "Last edited: " nil t))
      (progn (insert-string ";; Last edited: ")
	     (newline)
	     (forward-char -1))
    (if (not (looking-at "\n"))
	(kill-line)))
  (insert-time))

(global-set-key  "\em" 'note-edit)

(defun save-and-pause()
  (interactive)
  (save-some-buffers t)
  (suspend-emacs))
		  
(global-set-key  "\C-x." 'save-and-pause)
					 
(defun fix-comment-line ()
  "split comment onto enough lines to avoid overflow"
  (interactive)
  (indent-for-comment)
  (end-of-line)
  (if (> (current-column) 79)
      (progn
	(while (> (current-column) 79)
	  (re-search-backward "[ ]"))
	(indent-new-comment-line)
	(end-of-line))))

(defun fix-all-comments ()
  "iterate over file with fix-comment-line"
  (interactive)
  (while (search-forward ";" nil t)
    (fix-comment-line)))

(global-set-key "\e:" 'fix-comment-line)

(defun grind-file ()
  "grind all forms in a lisp file"
  (interactive)
  (beginning-of-buffer)
  (while (re-search-forward "^(" nil t)
    (beginning-of-line)
    (indent-sexp)
    (end-of-line)))

(defun suggest-breaks ()
  "suggest line breaks to improve indentation"
  (interactive)
  (set-mark (point))
  (message "Trying to add line breaks to over-long lines . . .")
  (let (finished)
    (while (not (or finished
		    (= (point)(point-max))))
      (end-of-line)
      (if (> (current-column) 79)
	  (let* ((left (progn (beginning-of-line)
			      (re-search-forward "[ 	]*")
			      (current-column)))
		 (min-pt (point))
		 (target (min 69 (/ (+ 79 left) 2))))
	    (end-of-line)
	    (while (and (> (current-column) target)
			(> (point) min-pt)
			(search-backward " " nil t)))
	    (if (<= (point) min-pt)
		(progn (goto-char min-pt)
		       (if (search-forward " " nil t)
			   (backward-char 1)
			 (message "losing %d %d %d" min-pt left target))))
	    (let ((help-form (quote
			      "y or <space> to break here,n or . or ! to stop, others interpreted"))
		  (re-probe t)
		  (char nil))
	      (while re-probe
		(setq re-probe nil)
		(setq char (read-char))
		(cond ((or (= char ??)
			   (= char help-char))
		       (message help-form))
		      ((or (= char ?\ )
			   (= char ?y))
		       (while (looking-at " ")
			 (delete-char 1))
		       (newline-and-indent)
		       (message
			"Trying to add line breaks to over-long lines . . ."))
		      ((or (= char ?n)
			   (= char ?\.)
			   (= char ?\!))
		       nil)
		      ((= char ?f)
		       (forward-char 1)
		       (search-forward " ")
		       (backward-char 1)
		       (setq re-probe t))
		      ((= char ?b)
		       (search-backward " ")
		       (setq re-probe t))
		      (t (setq unread-command-char char)
			 (setq finished t))))))
	(forward-line)))
    (message "Trying to add line breaks to over-long lines . . . done.")))

(defun set-left-margin ()
  (interactive)
  (if (and margin-stack
	   (< (current-column)(car margin-stack)))
      (setq margin-stack nil)
    (if (> (current-column) left-margin)
	(setq margin-stack (cons left-margin margin-stack))))
  (setq left-margin (current-column))
  (set-fill-prefix))

(defun pop-left-margin ()
  (interactive)
  (if margin-stack
      (progn (setq left-margin (car margin-stack))
	     (setq margin-stack (cdr margin-stack)))
    (setq left-margin 0))
  (move-to-column left-margin)
  (set-fill-prefix))

(setq text-mode-hook `(lambda nil (progn ,@ (mapcar (function list)
						    text-mode-hook))
			(turn-on-auto-fill)
			(abbrev-mode 1)
			(local-set-key "\C-cl" 'set-left-margin)
			(local-set-key "\C-cs" 'submerge-region)))

(global-set-key "\C-cp" 'pop-left-margin)

(setq margin-stack nil)

(global-set-key "\^Xn" 'other-window)	; as per emacs - used to be narrow
(global-set-key "\^Xp" 'other-window-up) ; "

(defun other-window-up (n)
  (interactive "p")
  (other-window (- (or n 1))))

(defun minibuffer-electric-tilde ()
  ;; by Stig@hackvan.com
  (interactive)
  (and (eq ?/ (preceding-char))
       (delete-region (point-min) (point)))
  (insert ?~))



;; Created by: Joe Wells, jbw@cs.bu.edu
;; Created on: Fri May 15 13:16:01 1992
;; Last modified by: Joe Wells, jbw@csd
;; Last modified on: Fri May 15 17:03:28 1992
;; Filename: backtrace-fix.el
;; Purpose: make backtrace useful when circular structures are on the stack

(or (fboundp 'original-backtrace)
    (fset 'original-backtrace
	  (symbol-function 'backtrace)))

(defconst backtrace-junk "\
  original-backtrace()
  (condition-case ...)
  (let ...)
  (save-excursion ...)
  (let ...)
")

(defun circ-backtrace ()
  "Print a trace of Lisp function calls currently active.
Output stream used is value of standard-output."
  (let (err-flag)
    (save-excursion
      (set-buffer (get-buffer-create " backtrace-temp"))
      (buffer-flush-undo (current-buffer))
      (erase-buffer)
      (let ((standard-output (current-buffer)))
	(condition-case err
	    (original-backtrace)
	  (error
	   (setq error-flag err))))
      (cond (err-flag
	     (goto-char (point-max))
	     (beginning-of-line 1)
	     ;; don't leave any unbalanced parens lying around
	     (delete-region (point) (point-max))))
      (goto-char (point-min))
      (search-forward backtrace-junk nil t)
      (delete-region (point-min) (point))
      (princ (buffer-substring (point-min) (point-max)))))
  nil)

(defun install-circ-bt ()
  (fset 'backtrace
	(symbol-function 'circ-backtrace)))

(defvar submerge-prefix "> "
   "prefix to submerge quoted text with")

(defun submerge-region (&optional start end)
  "submerge the current region"
  (interactive "r")
  (let ((fill-prefix submerge-prefix))
    (indent-region start end nil)))