I have the following piece of code in my .emacs:
(dolist (mode '(scheme emacs-lisp lisp clojure))
(add-hook
(intern (concat (symbol-name mode) "-mode-hook"))
(lambda ()
(progn
(run-programming-hook)
(message "%s" (concat (symbol-name mode) "-mode")))
Obviously the mode variable is void when lambda gets to execute. The question is how I evaluate mode in such a way that it doesn't get into a lambda as a variable but rather as a value in that variable? In other words, I want the message to be printed when the hook is run.
What you can use is backquote:
(dolist (mode '(scheme emacs-lisp lisp clojure))
(add-hook
(intern (concat (symbol-name mode) "-mode-hook"))
`(lambda ()
(run-programming-hook)
(message "%s" ,(concat (symbol-name mode) "-mode")))))
Related
I want to dynamically redirect one command to another one within a
certain function using around advice, something like this:
(defun f1 (arg)
(interactive (list (read-from-minibuffer "F1: ")))
(message "f1: %S" arg)
arg)
(defun f2 (arg)
(interactive (list (read-from-minibuffer "F2: ")))
(message "f2: %S" arg)
arg)
;; Function that invokes the f1 command
(defun myfunc ()
(call-interactively 'f1))
;; I want myfunc to invoke f2 instead whenever it would invoke f1
(defadvice myfunc (around f1-to-f2 activate)
(flet ((f1 (&rest args) (interactive) (call-interactively 'f2)))
ad-do-it))
(myfunc)
However, this gives an error (wrong-type-argument commandp f1),
indicating that when flet redefined the f1 function, it didn't
process the interactive form and treat it like a command, so it can't
be invoked by call-interactively.
Is there a variant of flet that will work for commands in this way?
(Here are the actual redefinitions I want to do:)
(defadvice org-metaleft (around osx-command activate)
(flet ((backward-word (&rest args)
(interactive)
(call-interactively #'move-beginning-of-line)))
ad-do-it))
(defadvice org-metaright (around osx-command activate)
(flet ((forward-word (&rest args)
(interactive)
(call-interactively #'move-end-of-line)))
ad-do-it))
You're bumping into a silly bug in flet: the macroexpansion of flet will have: (lambda (&rest args) (progn (interactive) (call-interactively 'f2))). Notice the spurious progn added in there, which "hides" the interactive.
To get more control (and avoid cl.el at the same time), you can do:
(defadvice myfunc (around f1-to-f2 activate)
(cl-letf (((symbol-function 'f1)
(lambda (&rest args)
(interactive) (call-interactively 'f2))))
ad-do-it))
(Edit: The cl-letf macro can do this natively in modern emacs. The answer below might still be useful for old versions.)
Well, if there wasn't before, there is now:
(require 'cl)
(require 'cl-lib)
(defmacro command-let (bindings &rest body)
"Like `flet', but works for interactive commands.
In addition to the standard `(FUNC ARGLIST BODY...)' syntax from
`flet', this also supports `(FUNC NEW-FUNC)' as a shorthand for
remapping command FUNC to another command NEW-FUNC, like this:
(defun FUNC (&rest ignored)
(interactive)
(call-interactively NEW-FUNC))
\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
(declare (indent 1))
(cl-loop for binding in bindings
collect (list (car binding) nil) into empty-bindings
collect (if (symbolp (cadr binding))
;; Remap one command to another
`(defun ,(car binding) (&rest args)
(interactive)
(call-interactively ',(cadr binding)))
;; Define command on the fly
(cons 'defun binding))
into defun-forms
finally return
`(flet (,#empty-bindings)
,#defun-forms
,#body)))
In action:
(defadvice myfunc (around f1-to-f2 activate)
(command-let ((f1 f2))
ad-do-it))
(myfunc)
That code now invokes the f2 command using call-interactively, as desired.
I am creating a simple macro to disable show trailing whitespace in certain major modes (I will loop this macro in a dolist loop later):
(defmacro non-trailing-whitespaces-modes (mode)
(let ((hook (intern (concat mode "-mode-hook"))))
`(add-hook ,hook (lambda () (setq show-trailing-whitespace nil)))))
After this macroexpand: (macroexpand '(non-trailing-whitespaces-modes "eshell")), the result is
(add-hook eshell-mode-hook
(lambda nil
(setq show-trailing-whitespace nil)))
I want eshell-mode-hook to be 'eshell-mode-hook, otherwise it will cause error.
Simply change the body of the macro to begin (add-hook ',hook ...)
No need for a macro, here:
(defun non-trailing-whitespaces-modes (mode)
(let ((hook (intern (concat mode "-mode-hook"))))
(add-hook hook (lambda () (setq show-trailing-whitespace nil)))))
I'm using org-mode for organizing myself (very useful so far!). However, it is kind of annoying writting
#+begin_comment
...
#+end_comment
each time I'd like to insert an environment.
Question
Is there a shortcut to insert the #+begin_ and #+end_ for a given environment?
In the same way C-c C-o comment RET would insert
\begin{comment}
\end{comment}
in latex-mode.
Org has a facility called "Easy templates": http://orgmode.org/manual/Easy-Templates.html
A template for comment is missing but you can add it with:
(add-to-list 'org-structure-template-alist '("C" "#+begin_comment\n?\n#+end_comment"))
And use it by typing <C followed by TAB.
Alternatively, you could use yasnippet.
Now the corresponding template section is called Structure Template and the insertion sequence is invoked by C-c C-,. I didn't (require 'org-tempo) which is described to support insertion keys like <s TAB.
The comment environment is already defined in org-structure-template-alist. So the comment would be inserted by
C-c C-, C
It's still possible to add a user defined sequence by, for example,
C-c C-, [TAB|RET|SPC] src python :results output :session
delivering
#+begin_src python :results output :session
#+end_src
(emacs 25.2.2, org-mode 9.2)
You could have a look at "org-auctex-keys.el", a minor mode which I created to offer AUCTeX key bindings within Org documents.
In this case, you'd use C-c C-e to insert an environment (prompt to enter the environment name), as what AUCTeX does.
If you're interested, check it out at https://github.com/fniessen/org-auctex-key-bindings.
Not as elegant as the answer of Michael Markert but maybe more expandable.
1) You can select a region and put the block around it or you can just put the block at point.
2) Keyword expansion and history.
3) Keystrokes: C-c b
The command could be further expanded. E.g., for the src block the various switches like -n -r and export to files could be supported.
(defun list-major-modes ()
"Returns list of potential major mode names (without the final -mode).
Note, that this is guess work."
(interactive)
(let (l)
(mapatoms #'(lambda (f) (and
(commandp f)
(string-match "-mode$" (symbol-name f))
;; auto-loaded
(or (and (autoloadp (symbol-function f))
(let ((doc (documentation f)))
(when doc
(and
(let ((docSplit (help-split-fundoc doc f)))
(and docSplit ;; car is argument list
(null (cdr (read (car docSplit)))))) ;; major mode starters have no arguments
(if (string-match "[mM]inor" doc) ;; If the doc contains "minor"...
(string-match "[mM]ajor" doc) ;; it should also contain "major".
t) ;; else we cannot decide therefrom
))))
(null (help-function-arglist f)))
(setq l (cons (substring (symbol-name f) 0 -5) l)))))
(when (called-interactively-p 'any)
(with-current-buffer (get-buffer-create "*Major Modes*")
(clear-buffer-delete)
(let ((standard-output (current-buffer)))
(display-completion-list l)
(display-buffer (current-buffer)))))
l))
(defvar org-insert-block-hist nil
"History for command `org-insert-block'")
(defvar org-insert-block-hist/src:major nil
"History for major mode in org src blocks.")
(defvar org-insert-block-list (append org-protecting-blocks
'("comment" ""))
"List of block types offered as completion for command `org-insert-block'")
;; block_src switches: -n () -r (references) -l "((%s))" (label format) -k (keep labels)
(defvar org-insert-block-list-specials
"Assoc list of Commands for reading additional specification of org-blocks.")
(setq org-insert-block-list-specials
'(("src" . (concat " " (completing-read "Major mode:"
(list-major-modes)
nil nil
(car org-insert-block-hist/src:major)
'(org-insert-block-hist/src:major . 1)
)))))
(defun org-insert-block (bl &optional b e attributes)
"Put region between b and e into org-block of kind bl.
If b or e is nil then put org-block limiters around point.
The string attributes is inserted behind the string #+begin_... "
(interactive
(let ((usereg (use-region-p))
(blKind (completing-read "Input block kind (tab: completion, uparrow: history):"
org-insert-block-list nil nil (car org-insert-block-hist) '(org-insert-block-hist . 1))))
(list
blKind
(when usereg (region-beginning))
(when usereg (region-end))
(let ((spec (assoc blKind org-insert-block-list-specials)))
(when spec (eval (cdr spec)))
))))
(let ((begBlock (concat "\n#+begin_" bl attributes "\n"))
(endBlock (concat "\n#+end_" bl "\n")))
(if (and b e)
(save-restriction
(narrow-to-region b e)
(goto-char (point-min))
(insert begBlock)
(goto-char (point-max))
(insert endBlock)
(indent-region (point-min) (point-max)))
(let ((p (point)))
(insert endBlock)
(goto-char p)
(insert begBlock))
)))
(add-hook 'org-mode-hook '(lambda ()
(local-set-key (kbd "C-c b") 'org-insert-block)))
I use this function for printing a buffer's content to PDF
(from my .emacs file:)
(defun print-to-pdf ()
(interactive)
(ps-spool-buffer-with-faces)
(switch-to-buffer "*PostScript*")
(write-file "/tmp/tmp.ps")
(kill-buffer "tmp.ps")
(setq cmd (concat "ps2pdf14 /tmp/tmp.ps /home/user/" (buffer-name) ".pdf"))
(shell-command cmd)
(shell-command "rm /tmp/tmp.ps")
(message (concat "Saved to: /home/user/" (buffer-name) ".pdf"))
)
I cannot, however, find a way to enable or apply the visual-line minor mode to the PostScript buffer before it gets written to disk so to enable word wrap in the output.
The problem with getting visual line mode to be respected is that it inserts "soft newlines" (which get ignored by the PS renderer). A solution is to replace these with hard newlines. The code below does what you want, I think. Note that we call harden-newlines in a temporary buffer so as not to mess up the current document. Also, I've changed the output destination to always land in /tmp/print.pdf. It seems... unwise to overwrite documents in your /home without any sort of warning! You can always move the PDF afterwards.
Anyway, here you go. Is this what you wanted?
(defun harden-newlines ()
(interactive)
"Make all the newlines in the buffer hard."
(save-excursion
(goto-char (point-min))
(while (search-forward "\n" nil t)
(backward-char)
(put-text-property (point) (1+ (point)) 'hard t)
(forward-char))))
(defun spool-buffer-given-name (name)
(load "ps-print")
(let ((tmp ps-left-header))
(unwind-protect
(progn
(setq ps-left-header
(list (lambda () name) 'ps-header-dirpart))
(ps-spool-buffer-with-faces))
(setf ps-left-header tmp))))
(defun print-to-pdf ()
"Print the current file to /tmp/print.pdf"
(interactive)
(let ((wbuf (generate-new-buffer "*Wrapped*"))
(sbuf (current-buffer)))
(jit-lock-fontify-now)
(save-current-buffer
(set-buffer wbuf)
(insert-buffer sbuf)
(longlines-mode t)
(harden-newlines)
(spool-buffer-given-name (buffer-name sbuf))
(kill-buffer wbuf)
(switch-to-buffer "*PostScript*")
(write-file "/tmp/print.ps")
(kill-buffer (current-buffer)))
(call-process "ps2pdf14" nil nil nil
"/tmp/print.ps" "/tmp/print.pdf")
(delete-file "/tmp/print.ps")
(message "PDF saved to /tmp/print.pdf")))
When executing the command shell-command, the output shown in the associated buffer is not colorized.
This is particularly annoying when calling a testing framework (outputting yellow/green/red...) from within emacs.
How can I configure, or extend, emacs in order to have shell-command allowing colorized output in the shell and preserving the colors while representing that output?
Thanks!
ps. I'm using the Bash shell, on a UN*X system.
This is probably what you want :
(add-hook 'shell-mode-hook 'ansi-color-for-comint-mode-on)
You can implement your own shell-execute, something like
(defun my-shell-execute(cmd)
(interactive "sShell command: ")
(shell (get-buffer-create "my-shell-buf"))
(process-send-string (get-buffer-process "my-shell-buf") (concat cmd "\n")))
This adds an advice to run ansi-color-apply-on-region on the minibuffer after shell-command finishes:
(require 'ansi-color)
(defun ansi-color-apply-on-buffer ()
(ansi-color-apply-on-region (point-min) (point-max)))
(defun ansi-color-apply-on-minibuffer ()
(let ((bufs (remove-if-not
(lambda (x) (string-starts-with (buffer-name x) " *Echo Area"))
(buffer-list))))
(dolist (buf bufs)
(with-current-buffer buf
(ansi-color-apply-on-buffer)))))
(defun ansi-color-apply-on-minibuffer-advice (proc &rest rest)
(ansi-color-apply-on-minibuffer))
(advice-add 'shell-command :after #'ansi-color-apply-on-minibuffer-advice)
;; (advice-remove 'shell-command #'ansi-color-apply-on-minibuffer-advice)
It does not rely on shell-mode or comint. I accompany it with something like the following to get nice test output (a green smiley with the count of successful doctests.
(defun add-test-function (cmd)
(interactive "sCommand to run: ")
(setq my-testall-test-function cmd)
(defun my-testall ()
(interactive)
(shell-command my-testall-test-function))
(local-set-key [f9] 'my-testall))
This solution is inspired by #ArneBabenhauserheide's but uses xterm-color instead of ansi-color. It also colorizes the *Shell Command Output* buffer as well as the mini
(defun xterm-color-colorize-shell-command-output ()
"Colorize `shell-command' output."
(let ((bufs
(seq-remove
(lambda (x)
(not (or (string-prefix-p " *Echo Area" (buffer-name x))
(string-prefix-p "*Shell Command" (buffer-name x)))))
(buffer-list))))
(dolist (buf bufs)
(with-current-buffer buf
(xterm-color-colorize-buffer)))))
(defun xterm-color-colorize-shell-command-output-advice (proc &rest rest)
(xterm-color-colorize-shell-command-output))
(advice-add 'shell-command :after #'xterm-color-colorize-shell-command-output-advice)
;; (advice-remove 'shell-command #'xterm-color-colorize-shell-command-output-advice)