Mercurial > hg > cc > cirrus_home
changeset 96:a7e72a254790
(none)
| author | Henry S. Thompson <ht@inf.ed.ac.uk> |
|---|---|
| date | Fri, 16 Apr 2021 09:01:16 +0000 |
| parents | 32c1c853062f |
| children | 2b880f2ce894 |
| files | lib/emacs/common-init.el lib/emacs/misc.el lib/emacs/pers-init.el |
| diffstat | 3 files changed, 696 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lib/emacs/misc.el Fri Apr 16 09:01:16 2021 +0000 @@ -0,0 +1,226 @@ +;; 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)) + +(add-hook 'text-mode-hook + (lambda nil + (turn-on-auto-fill) + (abbrev-mode 1) + (local-set-key "\C-cl" 'set-left-margin) + (local-set-key "\C-cs" 'submerge-region)) t) + +(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))) + + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lib/emacs/pers-init.el Fri Apr 16 09:01:16 2021 +0000 @@ -0,0 +1,470 @@ +;;; GNU Emacs init file for Henry Thompson +;;; This part shared between all hosts +;;; This part is my personal stuff, not for other incarnations +;;; initialisation file for Emacs, that is, (l)emacs and epoch common +;;; Last edited: Fri Sep 25 09:22:22 1992 +;;; Edit history since port: made load-path not site-dependant +;;; split into common-init for all my incarnations and pers-init for private +;;; added lemacs compatibility + +;;; mail stuff +(setq mail-archive-file-name "~/mail/cpy/general") +(setq rmail-dont-reply-to-names "hthompso*\\|h\\.thompso*\\|ht@*" ) +(set-default 'ht-last-file (expand-file-name "~/mail/")) +(setq ht-diary-file-name "~/mail/diary.babyl") +(setq mail-append-host "inf.ed.ac.uk") +(setq user-full-name "Henry S. Thompson") +(setq user-mail-address "ht@inf.ed.ac.uk") +(setq mail-host-address "inf.ed.ac.uk") + +;; new mail hackery +(site-caseq ((edin ircs ldc) + (setq rmail-spool-directory (file-name-as-directory + (concat rmail-spool-directory + "ht-mail"))))) + +;; sending mail on the road +;; [moved to mail-from-m.el, which is required by gnus-init.el + +;; don't know why this is necessary +(site-caseq ((edin) + (setq rmail-primary-inbox-list + (list (concat rmail-spool-directory "ht"))))) + +;; Perforce + +;;(setq p4-global-server-port "zorg.milowski.com:1666") +;;(setenv "P4PORT" "zorg.milowski.com:1666") +;;(setenv "P4CLIENT" "MarkupMan") +;;(setenv "P4CONFIG" ".p4env") +;;(load-library "p4") +;;(setq p4-use-p4config-exclusively t) +;;(p4-set-p4-executable "/c/Program Files/Perforce/p4.exe") +(setq vc-command-messages t) + +(setq minibuffer-max-depth nil) +(defun run-kcl () + "Run an inferior kcl process" + (interactive) + (switch-to-buffer (make-shell "kcl" "kcl")) + (inferior-lisp-mode)) + +;(require 'mdn-extras) +(setq auto-mode-alist + (append '(("/perl/" . perl-mode) + ("\\.scm$" . scheme-mode)) + auto-mode-alist)) +;(setq inferior-lisp-program "/c/Progra~1/ChezSc~1.4/bin/i3nt/petite") +;;; for scheme +(put 'letrec 'lisp-indent-function 1) +(put 'case 'lisp-indent-function 1) + +(site-caseq (parc (nconc load-path '("/import/local/emacs/gnus-3.13/")) + (setq rmail-primary-inbox-list + '("~/mbox" "/net/piglet/usr/spool/mail/$USER"))) + (edin (setq load-path (cons + "/home/ht/emacs/shared/gnus-5.0.15/lisp" + load-path)))) + +(defun run-sicstus () + "Run an inferior Prolog process, input and output via buffer *prolog*." + (interactive) + (if (not (boundp 'prolog-mode-map)) + (let ((load-path (cons + (site-caseq (parc "/import/prolog-1.8/emacs") + (edin "??")) + load-path))) + (load "prolog" nil t))) + (require 'shell) + (switch-to-buffer (make-shell "prolog" (site-caseq (edin "sicstus") + (parc "prolog")))) + (inferior-prolog-mode)) + +(site-caseq ((laptop maritain cirrus)) + (t(require 'hist) + (rplacd (assoc "*shell*" hk-pat-table) + "[a-z]+<[0-9]+>: "))) + +;; turn off suspend-emacs -- use pause-emacs (^X.) instead +(global-unset-key "\C-Z") +(global-unset-key "\C-x\C-z") + +(global-set-key "\C-xl" (function goto-line)) + +;(require 'repl-comment) + +;(require 'compress) + +(if (string-match "Lucid" emacs-version) + (site-caseq ((laptop maritain cirrus)) + (t(require 'lemacs-compat)))) + +(if (boundp 'epoch::version) + ;; epoch only goes here + (progn + (if (string-match "4\\."emacs-version) + (load "motion4" nil t) + (load "motion" nil t)) + (redisplay-frame) + + (require 'alarm) + (idle-save 15) + + (defun ht-rooms-setup (&optional arg) + (interactive) + (redisplay-frame) + (require 'mail-extras) + (require 'diary) + (require 'my-news) + (let ((scr (current-frame))) + (load "ht-rooms-epoch.config" nil t) + (unwind-protect (make-frame-for-room "diary" "-0" "+130")) + (unwind-protect (make-frame-for-room "elisp" "-25" "+148")) + (unwind-protect (make-frame-for-room "news" "-50" "+166")) + (unwind-protect (make-frame-for-room "mail" "-75" "+184")) + (epoch::delete-frame scr)) + ;; presumably this is now frame local, so not quite the right thing. + (setq ht-default-config (current-window-configuration))) + )) +(if (string-match "^\\(19\\|2\\)" emacs-version) + (progn + ;; common v19 + (if window-system + (progn + (add-hook 'sh-mode-hook '(lambda () + (font-lock-mode 1))) + (add-hook 'lsl-mode-hook '(lambda () + (font-lock-mode 1))) + (add-hook 'perl-mode-hook '(lambda () + (font-lock-mode 1))) + (add-hook 'emacs-lisp-mode-hook '(lambda () + (font-lock-mode 1))) + (add-hook 'lisp-mode-hook '(lambda () + (font-lock-mode 1))) + (add-hook 'sgml-mode-hook '(lambda () + (if (not + (boundp 'sgml-font-lock-keywords)) + (load "sgml-font-lock-keywords" t t)) + (setq adaptive-fill-mode nil) + (font-lock-mode 1) + )) + (add-hook 'c-mode-hook '(lambda () + (font-lock-mode 1))) + (add-hook 'c++-mode-hook '(lambda () + (font-lock-mode 1))) + (add-hook 'scheme-mode-hook + '(lambda () + (setq + scheme-font-lock-keywords + (if (or + (boundp 'lisp-font-lock-keywords) + (load "lisp-font-lock-keywords" t t)) + lisp-font-lock-keywords)) + (font-lock-mode 1))) + (add-hook 'python-mode-hook '(lambda () + (font-lock-mode 1))) + ;(setq py-python-command "//c/Program Files/Python22/python") + (setq sgml-insert-missing-element-comment nil) + ;(load "psgml" nil t) + ;(load "psgml-edit" nil t) + ;; (load "xml-hack" nil t) +; (setq sgml-catalog-files '("CATALOG" "f:/lib/sgml/catalog")) + (if (string-match "i386" (emacs-version)) + (progn (defun win32-get-clipboard-data-cmd () + (interactive)(insert (win32-get-clipboard-data))) + (global-set-key + "\C-x\C-y" 'win32-get-clipboard-data-cmd))) + ;; gnus +; (setq mail-signature t) + + ;; loading gnus postponed to e.g. mail-from-delphix, q.v. + + ; (require 'gnus-min) + )) + (site-caseq ((cirrus)) + (t (load "gnus-init" nil t))) + +;; (require 'idle) +;; (idle-save 15) + + (if (string-match "Lucid" emacs-version) + ;; lemacs only goes here + (site-caseq ((cirrus) + ;(load "perl-mode" nil t) + ) + (t(progn + (setq bbdb-north-american-phone-numbers-p nil) + (setq bbdb-use-pop-up nil) + (require 'bbdb) + (add-hook 'rmail-mode-hook 'bbdb-insinuate-rmail) + (add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus) + (add-hook 'mail-setup-hook 'bbdb-insinuate-sendmail) + (add-hook 'mail-setup-hook 'bbdb-define-all-aliases) + (add-hook 'gnus-message-setup-hook 'bbdb-define-all-aliases) + + + + (if window-system + (progn + (require 'highlight-headers) + (defun rmail-fontify-headers () + (highlight-headers (point-min) (point-max) t)) + (add-hook 'rmail-show-message-hook 'rmail-fontify-headers) + (setq dired-mode-hook + '(lambda () + (font-lock-mode 1) + (define-key dired-mode-map + [button2] '(lambda (click) + (interactive "e") + (mouse-set-point click) + (dired-advertised-find-file))))) +;; (setq highlight-headers-follow-url-function + ;; 'highlight-headers-ht-follow-url-netscape + ;; browse-url-browser-function + ;;'highlight-headers-ht-follow-url-netscape) + )) +;; (load "~rjc/public_html/device-type-hacking.el") + (load "perl-mode" nil t) + (defun ht-rooms-setup (&optional arg) + (interactive) + (require 'mail-extras) + (require 'diary) + (require 'my-news) + ;; override changed default, except in gnus + (setq mail-use-rfc822 nil) + (add-hook 'gnus-summary-mode-hook + (function (lambda () + (make-local-variable 'mail-use-rfc822) + (setq mail-use-rfc822 t)))) + (if (>= emacs-major-version 21) + (progn + (add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus) + (add-hook 'gnus-startup-hook 'bbdb-insinuate-message))) + (defun ht-rooms-setup (&optional arg) + (interactive) + (require 'mail-extras) + (require 'diary) + (let ((scr (selected-frame))) + ; (sit-for 5) + (load "ht-rooms.config" nil t) + (unwind-protect (make-screen-for-room "diary" "0" "+62")) + ; (sit-for 5) + (unwind-protect (make-screen-for-room "elisp" "-25" "+79")) + ; (sit-for 5) + (unwind-protect (make-screen-for-room "news" "-50" "+96")) + ; (sit-for 5) + (unwind-protect (make-screen-for-room "mail" "-75" "+113")) + (sit-for 1) + (delete-screen scr)) + (setq ht-default-config (current-window-configuration))))))) + ;; vanilla v19 goes here + (if window-system + (progn + (defvar ht-frame-parameter-mods + '((auto-raise . t) + (auto-lower . nil) + (cursor-type . bar))) + (nconc + (site-caseq ((laptop maritain) (list '(height . 35))) + ((cirrus)) + (t + (list + '(font . + "-adobe-courier-medium-r-normal--14-*")))) + ht-frame-parameter-mods + ) + ;; if we have X, we have ISO-Latin-1, so + ;; set char codes 128--255 to display as themselves. + (require 'disp-table) + (standard-display-8bit 161 255) +; (transient-mark-mode t) + ;; hightlight searching in bold + (setq search-highlight t) + (make-face 'isearch) + (copy-face 'bold 'isearch) +; (set-face-underline-p 'region t) +; (set-face-background 'region "white") +; (set-face-foreground 'region "black") +; (setq c++-font-lock-keywords 'undef) +; (setq c-font-lock-keywords 'undef) + (modify-frame-parameters + nil + ht-frame-parameter-mods) + (setq default-frame-alist + (append + ht-frame-parameter-mods default-frame-alist)) + ;; fix cut and paste + (setq interprogram-paste-function nil + interprogram-cut-function nil) + (defun ht-mouse-set-region (click) "set region and primary selection" + (interactive "e") + (mouse-set-region click) + (x-set-selection "PRIMARY" (buffer-substring (point)(mark)))) + (defun ht-mouse-drag-region (click) + "drag region and set primary selection" + (interactive "e") + (mouse-drag-region click) + (if mark-active + (x-set-selection "PRIMARY" (buffer-substring (point)(mark))))) + (global-set-key [drag-mouse-1] (function ht-mouse-set-region)) + (global-set-key [down-mouse-1] (function ht-mouse-drag-region)) + (defun ht-mouse-insert-primary (click) + "set point and insert primary selection" + (interactive "e") + (mouse-set-point click) + (push-mark nil nil t) + (insert (x-selection))) + (global-set-key [mouse-2] (function ht-mouse-insert-primary)) + (setq dired-mode-hook + '(lambda () + (font-lock-mode 1) + (define-key dired-mode-map + [mouse-2] '(lambda (click) + (interactive "e") + (mouse-set-point click) + (dired-advertised-find-file))))) + + (defun ht-rooms-setup (&optional arg) + (interactive) + (require 'mail-extras) + (require 'diary) + (require 'my-news) + ;; override changed default, except in gnus + (setq mail-use-rfc822 nil) + (add-hook 'gnus-summary-mode-hook + (function (lambda () + (make-local-variable 'mail-use-rfc822) + (setq mail-use-rfc822 t)))) + (let ((scr (selected-frame))) + (load "ht-rooms.config" nil t) + (unwind-protect (make-frame-for-room "elisp" "-25" "-58")) + (unwind-protect (progn + (make-frame-for-room "news" "-50" "-40") + )) + (unwind-protect (progn + (make-frame-for-room "mail" "-75" "-22") + )) + (unwind-protect (progn + (make-frame-for-room + "diary" + "-0" + (concat + "+" + (format + "%d" + (- + (cdr + (assoc + 'top + (frame-parameters + (cdr + (assoc + "elisp" + frames-table))))) + 18)))) + )) + (make-frame-invisible scr)) + (setq ht-default-config (current-window-configuration))))) + (setq sgml-insert-missing-element-comment nil) + (add-hook 'sgml-mode-hook 'sgml-fix-para) +)) + ;; v18 emacs only goes here + (progn + (require 'compress) + (defun ht-rooms-setup (&optional arg) + (interactive) + (require 'mail-extras) + (require 'diary) + (require 'my-news) + (load "ht-rooms.config" nil t) + (setq ht-default-config (current-window-configuration))))) + +(defun sgml-fix-para () + (setq paragraph-separate + "</[^>]*>\n\\([ \t]+\\| \\)") + (setq paragraph-start + "^[ \t]*</?[A-Za-z._-]+[ >]")) + +(defun highlight-headers-ht-follow-url-netscape (url) + (message "Sending URL to Netscape...") + (save-excursion + (set-buffer (get-buffer-create "*Shell Command Output*")) + (erase-buffer) + (if (equal 0 (call-process "netscape" nil t nil "-display" ":0.0" + "-remote" + (concat "openURL(" url ")"))) + ;; it worked + nil + ;; it didn't work, so start a new Netscape process. + (call-process "netscape" nil 0 nil url))) + (message "Sending URL to Netscape... done")) + +(site-caseq (laptop (defun system-name () "francis.markup.co.uk"))) + +(cd (user-home-directory)) + +(defun ht-custom-size () + (interactive) + (site-caseq ((laptop maritain) + (message (format "pw: %s" (device-pixel-width (selected-device)))))) + (if (fboundp 'device-pixel-width) + (let ((pw (device-pixel-width (selected-device))) + (ph (device-pixel-height (selected-device)))) + (cond ((= pw 2048) + ;; we're on a _really_ big external monitor + (set-frame-pixel-size (selected-frame) 900 1050) + (set-frame-position (selected-frame) 0 0)) + ((= pw 1920) + ;; we're on a 27" curved external monitor + (set-frame-pixel-size (selected-frame) 720 980) + (site-caseq (cirrus + (set-frame-position + (selected-frame) 0 0)) + (t + (set-frame-position + (selected-frame) -8 2)))) + ((= pw 1680) + ;; we're on a big external monitor + (font-menu-set-font nil nil 10) + (set-frame-pixel-size (selected-frame) 900 1000) + (set-frame-position (selected-frame) -3 -20)) + ((= pw 1097) + ;; we're on an XPS 13, mag. 300% + (require 'font-menu) + (font-menu-set-font nil nil 9) + (set-frame-pixel-size (selected-frame) 583 583); 80 x 39 + (set-frame-position (selected-frame) -5 -26)) + ((= pw 1536) + ;; we're on an XPS 13, mag. 250% + (require 'font-menu) + (font-menu-set-font nil nil 10) + (set-frame-pixel-size (selected-frame) 670 782); 81 x 49 + (set-frame-position (selected-frame) -5 -26)) + ((= ph 768) + ;; we're on a narrow cinema-ratio laptop + (set-frame-pixel-size (selected-frame) 690 710) + (set-frame-position (selected-frame) -5 -26)) + ((= ph 900) + ;; we're on a cinema-ratio laptop + (set-frame-pixel-size (selected-frame) 800 820) + (set-frame-position (selected-frame) -3 -20)) + ((= pw 1600) + ;; we're on a big external monitor + (set-frame-pixel-size (selected-frame) 900 1120) + (set-frame-position (selected-frame) -3 -20)) + ((= pw 1280) + (cond ((= ph 720) + (set-frame-pixel-size (selected-frame) 700 655) + (set-frame-position (selected-frame) -3 -30)) + (t + (set-frame-pixel-size (selected-frame) 700 960) + (set-frame-position (selected-frame) -3 -20)))))))) + +(ht-custom-size) + +;;; make dired list directories first +;(defadvice dired-insert-directory (before my-dired-insert-directory +; (dir-or-list switches &optional wildcard full-p)) +; (setq switches (concat switches " --group-directories-first"))) + +;(ad-activate 'dired-insert-directory)