diff misc.el @ 24:0e5b39d2f8bb

trying to clean up Paul vs. Maritain for Cirrus
author ht
date Sat, 07 Oct 2023 10:44:21 +0100
parents 5738cc494f7f
children 597d985bf448
line wrap: on
line diff
--- a/misc.el	Sat Oct 07 10:11:27 2023 +0100
+++ b/misc.el	Sat Oct 07 10:44:21 2023 +0100
@@ -1,224 +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)))
+;; 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)))