diff misc.el @ 31:129123962e51

trying to merge lib/emacs and xemacs
author Henry S Thompson <ht@inf.ed.ac.uk>
date Sat, 07 Oct 2023 12:43:14 +0100
parents 0e5b39d2f8bb
children 597d985bf448
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/misc.el	Sat Oct 07 12:43:14 2023 +0100
@@ -0,0 +1,224 @@
+;; 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)
+
+(make-variable-buffer-local 'margin-stack)
+(set-default '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)))