xemacs: misc.el comparison

comparison misc.el @ 7:5f3a215f12eb

*** empty log message ***

author	ht
date	Mon, 29 Aug 2005 08:51:09 +0100
parents
children	5738cc494f7f

comparison

equal deleted inserted replaced

-:dccf9e53f179
+:5f3a215f12eb
+;; 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)))

Mercurial > hg > xemacs

comparison misc.el @ 7:5f3a215f12eb