I search how to transparent my emacs window. But it doesn't work.
Something like this failed:
(global-set-key [(f8)] 'loop-alpha)
(setq alpha-list '((100 100) (95 65) (85 55) (75 45) (65 35)))
(defun loop-alpha ()
(interactive)
(let ((h (car alpha-list)))
((lambda (a ab)
(set-frame-parameter (selected-frame) 'alpha (list a ab))
(add-to-list 'default-frame-alist (cons 'alpha (list a ab)))
) (car h) (car (cdr h)))
(setq alpha-list (cdr (append alpha-list (list h))))
)
)
Here's a working implementation of what I think you were trying to do:
(global-set-key [(f8)] 'loop-alpha)
(defvar alpha-list '((100 100) (95 65) (85 55) (75 45) (65 35)))
(defun next-alpha ()
(let ((current-alpha
(or (frame-parameter (selected-frame) 'alpha)
(first alpha-list)))
(lst alpha-list))
(or (second
(catch 'alpha
(while lst
(when (equal (first lst) current-alpha)
(throw 'alpha lst))
(setf lst (cdr lst)))))
(first alpha-list))))
(defun loop-alpha ()
(interactive)
(let ((new-alpha (next-alpha))
(current-default (assoc 'alpha default-frame-alist)))
(set-frame-parameter (selected-frame) 'alpha new-alpha)
(if current-default
(setcdr current-default new-alpha)
(add-to-list 'default-frame-alist (cons 'alpha new-alpha)))))
Notice that any version you write that redefines alpha-list is going to behave very strangely with multiple frames. I would explain what was wrong with your code, but I honestly couldn't work out what it was supposed to do. Note that this would be somewhat easier to write if I allowed myself to (require 'cl) first, but I think this code should work - it does here at any rate!
Related
I have my Emacs default new frame set to
(setq default-frame-alist
'((top . 150) (left . 400)
(width . 120) (height . 50)))
Is there a way to write a funciton to offset each new frame by 5 units at top and left so that each new frame will not be perfectly superimposed on top of each other? In other words, I want to cascade all new frames.
My system is OS X with Emacs 24.3.1
I suggest that you modify default-frame-alist in before-make-frame-hook:
(add-hook 'before-make-frame-hook 'cascade-default-frame-alist)
(defun cascade-default-frame-alist ()
(setq default-frame-alist
(mapcar (lambda (kv)
(if (memq (car kv) '(top left))
(cons (car kv) (+ 5 (cdr kv)))
kv))
default-frame-alist)))
If you want to modify default-frame-alist in-place, you need to create it with list instead of quote:
(setq default-frame-alist (list (cons 'top 150) (cons 'left 400)
(cons 'width 120) (cons 'height 50)))
(defun cascade-default-frame-alist ()
(dolist (kv default-frame-alist)
(when (memq (car kv) '(top left))
(setcdr kv (+ 5 (cdr kv))))))
I'm writing a minor mode for emacs which, at the very least, will calculate a numeric value for each line in a buffer. I want to display this visually, preferable neatly before each line.
I know some minor modes draw to the fringe, and I know overlays are an option too (are these related?), but I can't find a good example of what I want anywhere.
Basically, I want to have something like the line numbers from linum-mode, but they will need to change every time the buffer is modified (actually, only whenever the line they're on changes). Something like a character counter for each line would be a good example. And I'd like it to not break linum-mode, but not depend on it, etc, if possible.
Here is a quick example of one way to put an overlay after linum-mode numbers and before the line of text. I will need to give some thought about right-alignment of the character count.
NOTE: This method contemplates that the linum-mode numbers are generated before the code that follows in this example. If the post-command-hook or the widow-scroll-functions hook is used to implement this proposed method, then those additions to the hooks would need to follow in time subsequently to the linum-mode functions attached to those same hooks.
The following example could be implemented with the post-command-hook and the window-scroll-functions hook. See the following link for an example of how to determine window-start and window-end before a redisplay occurs: https://stackoverflow.com/a/24216247/2112489
EDIT: Added right-alignment of character count -- contemplates a maximum of three digits (i.e., up to 999 characters per line). The text after the character count overlays are now left-aligned.
(save-excursion
(let* (
(window-start (window-start))
(window-end (window-end)))
(goto-char window-end)
(while (re-search-backward "\n" window-start t)
(let* (
(pbol (point-at-bol))
(peol (point-at-eol))
(raw-char-count (abs (- peol pbol)))
(starting-column
(propertize (char-to-string ?\uE001)
'display
`((space :align-to 1)
(space :width 0))))
(colored-char-count
(propertize (number-to-string raw-char-count)
'face '(:background "gray50" :foreground "black")
'cursor t))
(one-spacer
(propertize (char-to-string ?\uE001)
'display
`((space :width 1))))
(two-spacers
(propertize (char-to-string ?\uE001)
'display
`((space :width 2))))
(final-char-count
(cond
((and
(< raw-char-count 100)
(> raw-char-count 9))
(concat one-spacer colored-char-count))
((< raw-char-count 10)
(concat two-spacers colored-char-count))
(t colored-char-count))) )
(overlay-put (make-overlay pbol pbol)
'before-string
(concat starting-column final-char-count two-spacers) )))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; M-x char-count-mode
(defvar char-count-p nil
"When `char-count-p` is non-`nil`, the overlays are present.")
(make-variable-buffer-local 'char-count-p)
(defvar char-count-this-command nil
"This local variable is set within the `post-command-hook`; and,
is also used by the `window-scroll-functions` hook.")
(make-variable-buffer-local 'char-count-this-command)
(defvar char-count-overlay-list nil
"List used to store overlays until they are removed.")
(make-variable-buffer-local 'char-count-overlay-list)
(defun char-count-post-command-hook ()
"Doc-string."
(setq char-count-this-command this-command)
(character-count-function))
(defun character-count-window-scroll-functions (win _start)
"Doc-string."
(character-count-function))
(defun equal-including-properties--remove-overlays (beg end name val)
"Remove the overlays using `equal`, instead of `eq`."
(when (and beg end name val)
(overlay-recenter end)
(dolist (o (overlays-in beg end))
(when (equal-including-properties (overlay-get o name) val)
(delete-overlay o)))))
(defun character-count-function ()
"Doc-string for the character-count-function."
(when
(and
char-count-mode
char-count-this-command
(window-live-p (get-buffer-window (current-buffer)))
(not (minibufferp))
(pos-visible-in-window-p (point)
(get-buffer-window (current-buffer) (selected-frame)) t) )
(remove-char-count-overlays)
(save-excursion
(let* (
counter
(selected-window (selected-window))
(window-start (window-start selected-window))
(window-end (window-end selected-window t)) )
(goto-char window-end)
(catch 'done
(while t
(when counter
(re-search-backward "\n" window-start t))
(when (not counter)
(setq counter t))
(let* (
(pbol (point-at-bol))
(peol (point-at-eol))
(raw-char-count (abs (- peol pbol)))
(starting-column
(propertize (char-to-string ?\uE001)
'display
`((space :align-to 1) (space :width 0))))
(colored-char-count
(propertize (number-to-string raw-char-count)
'face '(:background "gray50" :foreground "black")))
(one-spacer
(propertize (char-to-string ?\uE001)
'display
`((space :width 1))))
(two-spacers
(propertize (char-to-string ?\uE001)
'display
`((space :width 2))))
(final-char-count
(cond
((and
(< raw-char-count 100)
(> raw-char-count 9))
(concat one-spacer colored-char-count))
((< raw-char-count 10)
(concat two-spacers colored-char-count))
(t colored-char-count)))
(ov-string (concat starting-column final-char-count two-spacers)) )
(push ov-string char-count-overlay-list)
(overlay-put (make-overlay pbol pbol) 'before-string ov-string)
(when (<= pbol window-start)
(throw 'done nil)) )))
(setq char-count-p t)))
(setq char-count-this-command nil) ))
(defun remove-char-count-overlays ()
(when char-count-p
(require 'cl)
(setq char-count-overlay-list
(remove-duplicates char-count-overlay-list
:test (lambda (x y) (or (null y) (equal-including-properties x y)))
:from-end t))
(dolist (description char-count-overlay-list)
(equal-including-properties--remove-overlays (point-min) (point-max) 'before-string description))
(setq char-count-p nil) ))
(defun turn-off-char-count-mode ()
(char-count-mode -1))
(define-minor-mode char-count-mode
"A minor-mode that places the character count at the beginning of the line."
:init-value nil
:lighter " Char-Count"
:keymap nil
:global nil
:group nil
(cond
(char-count-mode
(setq scroll-conservatively 101)
(add-hook 'post-command-hook 'char-count-post-command-hook t t)
(add-hook 'window-scroll-functions
'character-count-window-scroll-functions t t)
(add-hook 'change-major-mode-hook 'turn-off-char-count-mode nil t)
(message "Turned ON `char-count-mode`."))
(t
(remove-char-count-overlays)
(remove-hook 'post-command-hook 'char-count-post-command-hook t)
(remove-hook 'window-scroll-functions
'character-count-window-scroll-functions t)
(remove-hook 'change-major-mode-hook 'turn-off-char-count-mode t)
(kill-local-variable 'scroll-conservatively)
(message "Turned OFF `char-count-mode`.") )))
(provide 'char-count)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
I'd like to be able to toggle the case of the letter under the point. To that end, I wrote this:
(defun toggle-case-next-letter ()
"Toggles the case of the next letter, then moves the point forward one character"
(interactive)
(let* ((p (point))
(upcased (upcasep (char-after)))
(f (if upcased 'downcase-region 'upcase-region)))
(progn
(f p (+ 1 p))
(forward-char))))
However, when I run it (I've bound it to M-#), I get progn: Symbol's function definition is void: f. I assume this means f isn't bound, but I'm not sure.
Upcasep is defined as:
(defun upcasep (c) (eq c (upcase c)))
Is the problem in the let binding, or something else? (Also, if there's a better way to do this, that'd be nice as well).
Note that originally I had (upcased (upcasep (buffer-substring-no-properties p (+ 1 p)))), which I've corrected to (upcased (upcasep (char-after)), because using upcasep as defined above is always nil for strings (so I couldn't downcase again).
You've got a typical case of lisp-1 / lisp-2 confusion. Here's a fix (just a funcall):
(defun toggle-case-next-letter ()
"Toggles the case of the next letter, then moves the point forward one character"
(interactive)
(let* ((p (point))
(upcased (char-upcasep (buffer-substring-no-properties p (+ 1 p))))
(f (if upcased 'downcase-region 'upcase-region)))
(progn
(funcall f p (+ 1 p))
(forward-char))))
And here's what I have:
(global-set-key (kbd "C->") 'upcase-word-toggle)
(global-set-key (kbd "C-z") 'capitalize-word-toggle)
(defun char-upcasep (letter)
(eq letter (upcase letter)))
(defun capitalize-word-toggle ()
(interactive)
(let ((start (car
(save-excursion
(backward-word)
(bounds-of-thing-at-point 'symbol)))))
(if start
(save-excursion
(goto-char start)
(funcall
(if (char-upcasep (char-after))
'downcase-region
'upcase-region)
start (1+ start)))
(capitalize-word -1))))
(defun upcase-word-toggle ()
(interactive)
(let ((bounds (bounds-of-thing-at-point 'symbol))
beg end
regionp)
(if (eq this-command last-command)
(setq regionp (get this-command 'regionp))
(put this-command 'regionp nil))
(cond
((or (region-active-p) regionp)
(setq beg (region-beginning)
end (region-end))
(put this-command 'regionp t))
(bounds
(setq beg (car bounds)
end (cdr bounds)))
(t
(setq beg (point)
end (1+ beg))))
(save-excursion
(goto-char (1- beg))
(and (re-search-forward "[A-Za-z]" end t)
(funcall (if (char-upcasep (char-before))
'downcase-region
'upcase-region)
beg end)))))
I couldn't get #abo-abo's answer working for me but using his comments I was able to google better and found the following at http://chneukirchen.org/dotfiles/.emacs
(defun chris2-toggle-case ()
(interactive)
(let ((char (following-char)))
(if (eq char (upcase char))
(insert-char (downcase char) 1 t)
(insert-char (upcase char) 1 t)))
(delete-char 1 nil)
(backward-char))
(global-set-key (kbd "M-#") 'chris2-toggle-case)
This answers the original question if you remove (backward-char).
I realize this is a very old question, but having stumbled upon the same problem recently, I'd like to suggest a simpler solution.
I start with a pure function for toggling character case, based on char code property inspection:
(cl-defun toggle-char-case (c)
(cl-case (get-char-code-property c 'general-category)
(Lu (downcase c))
(Ll (upcase c))
(t c)))
I then use it from within an interactive function operating at point:
(cl-defun toggle-char-case-at-point ()
(interactive)
(let ((new (toggle-char-case (char-after))))
(delete-char 1)
(insert new)))
I then bound this interactive function to a keybinding of my choice:
(global-set-key (kbd "C-M-c") 'toggle-char-case-at-point)
The way this function operates is, after toggling the case it advances the point by one. So calling it repeatedly will toggle the cases of a sequence of chars. One could make it keep the point unchanged - that would require adding (backward-char) to the body.
From reading a Lisp book I remember they showed an example of an OOP-style method dispatcher based on closures:
(defun create-object ()
(let ((val 0)
(get (lambda () val))
(set (lambda (new-val) (setq val new-val)))
(inc (lambda () (setq val (+ 1 val)))))
(lambda (method)
(cond ((eq method 'get)
get)
((eq method 'set)
set)
((eq method 'inc)
inc)))))
(let ((obj (create-object)))
(funcall (obj 'set) 1)
(funcall (obj 'inc))
(funcall (obj 'get))) ;; 2
Since it's just a function with a string symbol argument, I guess code intel won't be of much help here, not completing the method names or their signatures. (Compare with a similar JavaScript object.)
Is this problem generally solved? How do you program an object system in Scheme so that an editor (like Emacs) can be more intelligent with your code?
P.S. The example may be not a valid Scheme code, but you should get the idea.
I've made some starting code for you.
It's for Emacs Lisp, but it's should be very easily portable to Scheme.
Here's your usage example:
(defun create-object ()
(lexical-let* ((val 0)
(get (lambda() val))
(set (lambda(x) (setq val x))))
(generate-dispatch-table get set)))
(setq obj (create-object))
(funcall (funcall obj 'get))
;; => 0
(funcall (funcall obj 'set) 1)
;; => 1
(funcall (funcall obj 'get))
;; => 1
(scheme-completions obj)
;; => (get set)
And here's how it's implemented:
(defmacro generate-dispatch-table (&rest members)
`(lambda (method)
(cond ,#(mapcar
(lambda (x) `((eq method ',x) ,x)) members))))
(defun collect (pred x)
(when (and x (listp x))
(let ((y (funcall pred x))
(z (append
(collect pred (car x))
(collect pred (cdr x)))))
(if y
(append (list y) z)
z))))
(defun scheme-completions (obj)
(collect
(lambda(x) (and (eq (car x) 'eq)
(eq (cadr x) 'method)
(eq (caaddr x) 'quote)
(cadr (caddr x))))
obj))
And here's a simple visual interface for completions:
(require 'helm)
(defun scheme-completions-helm ()
(interactive)
(let ((y (and
(looking-back "(funcall \\([^ ]*\\) +")
(intern-soft (match-string 1)))))
(when y
(helm :sources
`((name . "members")
(candidates . ,(scheme-completions (eval y)))
(action . (lambda(x) (insert "'" x))))))))
I'm not a Emacs user, but use DrRacket and it does have an object system and do what an IDE should do, but I know Emacs is very customizable since it uses elisp so you can make support for your own syntax both in syntax highlighting and tab-completion. So you do:
Make your own object system
Edit your Emacs editor to do what you want
Many of my colleagues use it and they fix their Emacs in such ways.
Another thing, this question makes me think about the resources at schemewiki.org on the subject where the different approaches are mentioned and even a similar code to the one you posted is posted as example. It's a good read.
I would avoid double notion of symbols in create-object via an obarray.
Furthermore, the interface of the object are all functions. Therefore, use fset and avoid the double funcall.
(defun create-object ()
(lexical-let (val
(_oa (make-vector 11 0)))
(fset (intern "get" _oa) (lambda () val))
(fset (intern "inc" _oa) (lambda () (incf val)))
(fset (intern "set" _oa) (lambda (new-val) (setq val new-val)))
(lambda (method &rest args)
(apply 'funcall (intern (symbol-name method) _oa) args))))
(fset 'obj1 (create-object))
(fset 'obj2 (create-object))
(obj1 'set 1)
(obj2 'set 2)
(obj1 'inc)
(obj2 'inc)
(obj2 'inc)
(obj2 'get)
(obj1 'get)
Example for inheritance:
(defun create-object ()
(lexical-let (val
(_oa (make-vector 11 0)))
(fset (intern "get" _oa) (lambda () val))
(fset (intern "inc" _oa) (lambda () (incf val)))
(fset (intern "set" _oa) (lambda (new-val) (setq val new-val)))
(lambda (method &rest args)
(apply 'funcall (or (intern-soft (symbol-name method) _oa)
(error "Undefined function: %s" method))
args))))
(defun create-object-add10 ()
(lexical-let ((base (create-object))
(_oa (make-vector 11 0)))
(fset (intern "inc" _oa) (lambda () (funcall base 'set (+ (funcall base 'get) 10))))
(lambda (method &rest args)
(let ((call (intern-soft (symbol-name method) _oa)))
(if call
(apply 'funcall call args)
(apply 'funcall base method args))))))
(fset 'obj1 (create-object))
(fset 'obj2 (create-object-add10))
(obj1 'set 1)
(obj2 'set 2)
(obj1 'inc)
(obj2 'inc)
(obj2 'inc)
(obj2 'get)
(obj1 'get)
The definition of create-object-like methods should additionally be supported through macros. That is not done here.
For more features, note, there is a CLOS-compatible object oriented system in emacs:
https://www.gnu.org/software/emacs/manual/html_node/eieio/index.html
One can easily map some key to scroll up.
(defun up1()
(interactive)
(scroll-up 1))
(defun up2()
(interactive)
(scroll-up 2))
(global-set-key "\M-]" 'up2)
I am looking instead for the following behavior. The first handful of
scrolls would call up1() and the subsequent ones would call up2().
How about this:
(setq my-scroll-counter 0)
(setq my-scroll-limit 5)
(defun up1()
(interactive)
(if (eq last-command this-command)
(incf my-scroll-counter)
(setq my-scroll-counter 0))
(if (> my-scroll-counter my-scroll-limit)
(scroll-up 2)
(scroll-up 1)))
(global-set-key "\M-]" 'up1)
If you want something a little fancier, you calculate your scroll step dynamically based on how many times you repeat the command:
(setq my-scroll-counter 0)
(setq my-maximum-scroll 20)
(setq my-scroll-acceleration 4)
(defun up1()
(interactive)
(if (eq last-command this-command)
(incf my-scroll-counter)
(setq my-scroll-counter 0))
(scroll-up (min
(+ 1 (/ my-scroll-counter my-scroll-acceleration))
my-maximum-scroll)))
(global-set-key "\M-]" 'up1)