Mercurial > hg > xemacs
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)))