X-Git-Url: https://git.distorted.org.uk/~mdw/profile/blobdiff_plain/f33e684cacba4ae791bd013438959834be43e5f5..3b361ad218cb4463349c91f10117c29972b8a24c:/el/dot-emacs.el

diff --git a/el/dot-emacs.el b/el/dot-emacs.el
index 2a19ad1..f164c40 100644
--- a/el/dot-emacs.el
+++ b/el/dot-emacs.el
@@ -241,6 +241,10 @@ fringes is not taken out of the allowance for WIDTH, unlike
     (select-window win)))
 
 (defun mdw-set-frame-width (columns &optional width)
+  "Set the current frame to be the correct width for COLUMNS columns.
+
+If WIDTH is non-nil, then it provides the width for the new columns.  (This
+can be set interactively with a prefix argument.)"
   (interactive "nColumns: 
 P")
   (setq width (if width (prefix-numeric-value width)
@@ -259,6 +263,23 @@ P")
 
 This is sadly necessary because Emacs 26 is broken in this regard.")
 
+(defvar mdw-frame-colour-alist
+  '((black . ("#000000" . "#ffffff"))
+    (red . ("#2a0000" . "#ffffff"))
+    (green . ("#002a00" . "#ffffff"))
+    (blue . ("#00002a" . "#ffffff")))
+  "*Alist mapping symbol names to (FOREGROUND . BACKGROUND) colour pairs.")
+
+(defun mdw-set-frame-colour (colour &optional frame)
+  (interactive "xColour name or (FOREGROUND . BACKGROUND) pair: 
+")
+  (when (and colour (symbolp colour))
+    (let ((entry (assq colour mdw-frame-colour-alist)))
+      (unless entry (error "Unknown colour `%s'" colour))
+      (setf colour (cdr entry))))
+  (set-frame-parameter frame 'background-color (car colour))
+  (set-frame-parameter frame 'foreground-color (cdr colour)))
+
 ;; Don't raise windows unless I say so.
 
 (defvar mdw-inhibit-raise-frame nil
@@ -1361,6 +1382,48 @@ case."
 ;;;--------------------------------------------------------------------------
 ;;; Printing.
 
+;; Teach PostScript about a condensed variant of Courier.  I'm using 85% of
+;; the usual width, which happens to match `mdwfonts', and David Carlisle's
+;; `pslatex'.  (Once upon a time, I used 80%, but decided consistency with
+;; `pslatex' was useful.)
+(setq ps-user-defined-prologue "
+/CourierCondensed /Courier
+/CourierCondensed-Bold /Courier-Bold
+/CourierCondensed-Oblique /Courier-Oblique
+/CourierCondensed-BoldOblique /Courier-BoldOblique
+  4 { findfont [0.85 0 0 1 0 0] makefont definefont pop } repeat
+")
+
+;; Hack `ps-print''s settings.
+(eval-after-load 'ps-print
+  '(progn
+
+     ;; Notice that the comment-delimiters should be in italics too.
+     (pushnew 'font-lock-comment-delimiter-face ps-italic-faces)
+
+     ;; Select more suitable colours for the main kinds of tokens.  The
+     ;; colours set on the Emacs faces are chosen for use against a dark
+     ;; background, and work very badly on white paper.
+     (ps-extend-face '(font-lock-comment-face "darkgreen" nil italic))
+     (ps-extend-face '(font-lock-comment-delimiter-face "darkgreen" nil italic))
+     (ps-extend-face '(font-lock-string-face "RoyalBlue4" nil))
+     (ps-extend-face '(mdw-punct-face "sienna" nil))
+     (ps-extend-face '(mdw-number-face "OrangeRed3" nil))
+
+     ;; Teach `ps-print' about my condensed varsions of Courier.
+     (setq ps-font-info-database
+	     (append '((CourierCondensed
+			(fonts (normal . "CourierCondensed")
+			       (bold . "CourierCondensed-Bold")
+			       (italic . "CourierCondensed-Oblique")
+			       (bold-italic . "CourierCondensed-BoldOblique"))
+			(size . 10.0)
+			(line-height . 10.55)
+			(space-width . 5.1)
+			(avg-char-width . 5.1)))
+		     (cl-remove 'CourierCondensed ps-font-info-database
+				:key #'car)))))
+
 ;; Arrange to strip overlays from the buffer before we print .  This will
 ;; prevent `flyspell' from interfering with the printout.  (It would be less
 ;; bad if `ps-print' could merge the `flyspell' overlay face with the
@@ -2143,16 +2206,16 @@ set."
 		   (statement-cont . +)
 		   (statement-case-intro . +)))
 
-(mdw-define-c-style mdw-trustonic-basic-c (mdw-c)
+(mdw-define-c-style mdw-trustonic-c (mdw-c)
   (c-basic-offset . 4)
-  (comment-column . 0)
   (c-indent-comment-alist (anchored-comment . (column . 0))
 			  (end-block . (space . 1))
 			  (cpp-end-block . (space . 1))
 			  (other . (space . 1)))
   (c-offsets-alist (access-label . -2)))
 
-(mdw-define-c-style mdw-trustonic-c (mdw-trustonic-basic-c)
+(mdw-define-c-style mdw-trustonic-alec-c (mdw-trustonic-c)
+  (comment-column . 0)
   (c-offsets-alist (arglist-cont-nonempty . mdw-c-indent-arglist-nested)))
 
 (defun mdw-set-default-c-style (modes style)
@@ -4636,7 +4699,8 @@ align the other subforms beneath it.  Otherwise, indent them
 			     (current-column))))
 
     ;; Don't really care about this.
-    (when (and (eq lisp-indent-backquote-substitution-mode 'corrected))
+    (when (and (boundp 'lisp-indent-backquote-substitution-mode)
+	       (eq lisp-indent-backquote-substitution-mode 'corrected))
       (save-excursion
 	(goto-char (elt state 1))
 	(cl-incf loop-indentation
@@ -4665,7 +4729,14 @@ align the other subforms beneath it.  Otherwise, indent them
 
       (setq ad-return-value
 	      (list
-	       (cond ((not (lisp-extended-loop-p (elt state 1)))
+	       (cond ((condition-case ()
+			  (save-excursion
+			    (goto-char (elt state 1))
+			    (forward-char 1)
+			    (forward-sexp 2)
+			    (backward-sexp 1)
+			    (not (looking-at "\\(:\\|\\sw\\)")))
+			(error nil))
 		      (+ baseline-indent lisp-simple-loop-indentation))
 		     ((looking-at "^\\s-*\\(:?\\sw+\\|;\\)")
 		      (+ baseline-indent lisp-loop-keyword-indentation))