Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

merged from purcell

  • Loading branch information...
commit 216c38ab09a8b9f2b1aac18c98a4ada0031e1b60 2 parents ab0177e + 06372d6
@redguardtoo redguardtoo authored
View
25 init-compat.el
@@ -0,0 +1,25 @@
+;;----------------------------------------------------------------------------
+;; Provide a version of Emacs 24's 'string-prefix-p in older emacsen
+;;----------------------------------------------------------------------------
+(unless (fboundp 'string-prefix-p)
+ (defun string-prefix-p (str1 str2 &optional ignore-case)
+ "Return non-nil if STR1 is a prefix of STR2.
+If IGNORE-CASE is non-nil, the comparison is done without paying attention
+to case differences."
+ (eq t (compare-strings str1 nil nil
+ str2 0 (length str1) ignore-case))))
+
+
+;;----------------------------------------------------------------------------
+;; Allow recent packages to safely pass an arg to 'called-interactively-p
+;; in older Emacsen, including 23.1.
+;;----------------------------------------------------------------------------
+(let ((fn (symbol-function 'called-interactively-p)))
+ (when (zerop (cdr-safe (subr-arity fn)))
+ (message "Warning: overriding called-interactively-p to support an argument.")
+ (fset 'smp--called-interactively-p fn)
+ (defun called-interactively-p (&optional kind)
+ "Overridden; see `smp--called-interactively-p' for the wrapped function."
+ (smp--called-interactively-p))))
+
+(provide 'init-compat)
View
15 init-editing-utils.el
@@ -56,21 +56,6 @@
;;----------------------------------------------------------------------------
;; Fix per-window memory of buffer point positions
;;----------------------------------------------------------------------------
-; If we have a version of called-interactively-p that doesn't accept
-; arguments, redefine it so that it does take arguments. This
-; retains compatibility with packages that pass arguments to
-; called-interactively-p.
-(condition-case nil (called-interactively-p 'interactive)
- (error
- ; Save reference to called-interactively-p in
- ; inglorion-system-called-interactively-p
- (fset 'inglorion-system-called-interactively-p
- (symbol-function 'called-interactively-p))
- ; Define called-interactively-p so that it discards
- ; its arguments and calls inglorion-system-called-interactively-p
- (fset 'called-interactively-p
- (lambda (&rest args)
- (inglorion-system-called-interactively-p)))))
(global-pointback-mode)
View
39 init-fonts.el
@@ -1,20 +1,27 @@
(require 'cl)
-(defmacro preserving-maximization (&rest body)
- (let ((maximized-frames (gensym)))
- `(let ((,maximized-frames (loop for f in (frame-list)
- when (maximized-p f)
- collect f)))
- (prog1 (progn ,@body)
- (dolist (frame ,maximized-frames)
- (select-frame frame)
- (maximize-frame))))))
+
+(defun font-name-replace-size (font-name new-size)
+ (let ((parts (split-string font-name "-")))
+ (setcar (nthcdr 7 parts) (format "%d" new-size))
+ (mapconcat 'identity parts "-")))
(defun increment-default-font-height (delta)
- (preserving-maximization
- (let ((new-height (+ (face-attribute 'default :height) delta)))
- (set-face-attribute 'default nil :height new-height)
- (message "default font size is now %d" (/ new-height 10)))))
+ "Adjust the default font height by DELTA on every frame.
+The pixel size of the frame is kept (approximately) the same.
+DELTA should be a multiple of 10, in the units used by the
+:height face attribute."
+ (let* ((new-height (+ (face-attribute 'default :height) delta))
+ (new-point-height (/ new-height 10)))
+ (dolist (f (frame-list))
+ (with-selected-frame f
+ ;; Latest 'set-frame-font supports a "frames" arg, but
+ ;; we cater to Emacs 23 by looping instead.
+ (set-frame-font (font-name-replace-size (face-font 'default)
+ new-point-height)
+ t)))
+ (set-face-attribute 'default nil :height new-height)
+ (message "default font size is now %d" new-point-height)))
(defun increase-default-font-height ()
(interactive)
@@ -27,12 +34,6 @@
(global-set-key (kbd "C-M-=") 'increase-default-font-height)
(global-set-key (kbd "C-M--") 'decrease-default-font-height)
-(defmacro preserving-default-font-size (&rest body)
- (let ((old-size (gensym)))
- `(preserving-maximization
- (let ((,old-size (face-attribute 'default :height)))
- (prog1 (progn ,@body)
- (set-face-attribute 'default nil :height ,old-size))))))
(provide 'init-fonts)
View
7 init-gui-frames.el
@@ -39,6 +39,13 @@
(modify-frame-parameters frame (list (cons 'alpha newalpha))))))
(when (fboundp 'ns-toggle-fullscreen)
+ (defadvice ns-toggle-fullscreen (after mark-full-screen activate)
+ (set-frame-parameter nil
+ 'is-full-screen
+ (not (frame-parameter nil 'is-full-screen))))
+
+
+
;; Command-Option-f to toggle fullscreen mode
(global-set-key (kbd "M-ƒ") 'ns-toggle-fullscreen))
View
6 init-sessions.el
@@ -4,10 +4,8 @@
(setq desktop-save 'if-exists)
(desktop-save-mode 1)
(defadvice desktop-read (around trace-desktop-errors)
- (let ((old-debug-on-error debug-on-error))
- (setq debug-on-error t)
- ad-do-it
- (setq debug-on-error old-debug-on-error)))
+ (let ((debug-on-error t))
+ ad-do-it))
;;----------------------------------------------------------------------------
View
12 init-utils.el
@@ -1,16 +1,4 @@
;;----------------------------------------------------------------------------
-;; Provide a version of Emacs 24's 'string-prefix-p in older emacsen
-;;----------------------------------------------------------------------------
-(unless (fboundp 'string-prefix-p)
- (defun string-prefix-p (str1 str2 &optional ignore-case)
- "Return non-nil if STR1 is a prefix of STR2.
-If IGNORE-CASE is non-nil, the comparison is done without paying attention
-to case differences."
- (eq t (compare-strings str1 nil nil
- str2 0 (length str1) ignore-case))))
-
-
-;;----------------------------------------------------------------------------
;; Handier way to add modes to auto-mode-alist
;;----------------------------------------------------------------------------
(defun add-auto-mode (mode &rest patterns)
View
5 init.el
@@ -22,6 +22,11 @@
; Load configs for specific features and modes
;----------------------------------------------------------------------------
(require 'init-modeline)
+
+;;----------------------------------------------------------------------------
+;; Load configs for specific features and modes
+;;----------------------------------------------------------------------------
+(require 'init-compat)
(require 'init-utils)
(require 'init-site-lisp) ;; Must come before elpa, as it may provide package.el
(require 'init-elpa)
Please sign in to comment.
Something went wrong with that request. Please try again.