How can I display the name of a bookmark (from 'bookmark' or 'bookmark+') in the mode line of emacs, instead of the file name?
A slightly strange request, but here you go (works for files and dired buffers):
(defun show-bookmarks-mode-line ()
(interactive)
(let (bname text)
(and
(setq bname (if (eq major-mode 'dired-mode)
default-directory
(buffer-file-name)))
(setq bname (expand-file-name bname))
(setq text
(delq nil
(mapcar
(lambda (x)
(and (equal bname
(expand-file-name
(bookmark-get-filename x)))
(substring-no-properties (car x))))
bookmark-alist)))
(setq text
(mapconcat
#'identity
text
", "))
(let ((mode-line-buffer-identification
(propertize text 'face 'mode-line-buffer-id)))
(force-mode-line-update)
(sit-for 5))
(force-mode-line-update))))
Could you elaborate on why you need it?
Related
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'm looking for some assistance please, to distinguish between a single file extension in dired-mode (e.g., *.gz) and a double file extension (e.g., *.tar.gz).
The following is an excerpt of the function that I use when selecting one or more files in dired-mode to take specific actions -- e.g., open in Emacs, start a process and open externally, or compress / decompress. I originally wrote this function (borrowing excerpts from dired-do-create-files within dired-aux.el) with only single file type extensions in mind, and would now like to expand its functionality to include potential double file type extensions.
(defun test-for-tar-gz-extension ()
(interactive)
(let* (
(fn-list (dired-get-marked-files))
(rfn-list (mapcar (function dired-make-relative) fn-list))
(dired-one-file (and (consp fn-list) (null (cdr fn-list)) (car fn-list)))
(input-filename (if dired-one-file dired-one-file fn-list))
(ext
(cond
((stringp input-filename)
(file-name-extension input-filename))
((listp input-filename)
(file-name-extension (car input-filename)))))
(path (if (stringp input-filename) (file-name-directory input-filename)))
(dired-buffer-name (buffer-name))
(msword-regexp '("doc" "docx"))
(dired-tar '("tar.gz")))
(cond
;; http://www.emacswiki.org/emacs/DiredTar
((extension equals ".tar.gz")
(dired-tar-pack-unpack))
((extension equals ".gz" (but not .tar.gz))
(dired-do-compress))
((regexp-match-p msword-regexp ext)
(start-process "ms-word" nil "open" "-a" "Microsoft Word" input-filename))
(t
(message "Go fish.")))))
;; https://github.com/kentaro/auto-save-buffers-enhanced
;; `regexp-match-p` function modified by #sds on stackoverflow
;; http://stackoverflow.com/a/20343715/2112489
(defun regexp-match-p (regexps string)
(and string
(catch 'matched
(let ((inhibit-changing-match-data t)) ; small optimization
(dolist (regexp regexps)
(when (string-match regexp string)
(throw 'matched t)))))))
Not sure IIUC, here a draft how to do that part in question:
(defun gz-only ()
"List marked files in dired-buffer ending at `.gz', but not ending at `.tar.gz'"
(interactive)
(let ((flist (dired-get-marked-files))
erg)
(dolist (ele flist)
(and (string-match "\.gz$" ele)(not (string-match "\.tar\.gz$" ele))
(add-to-list 'erg ele)))
(when (interactive-p) (message "%s" erg))))
I am defining a major mode that works on paragraphs of the following nature:
: Identifier
1. some text
2. ...
3. some more text
: New Identifier
: Another Identifier
some text
I want to write a defun called get-paragraphs that will return a list that looks like:
( ("Identifier", ("1. some text", "2. ...", "3. some more text")),
("New Identifier", ()),
("Another Identifier", ("some text"))
)
How do I go about cutting up the text like this in Emacs Lisp:
Is there a function to iterate through them (and subsequently chop them up to my liking)? Should I use regular expressions? Is there an easier way?
You should iterate over the buffer and collect your text (untested):
(defun get-paragraphs ()
(save-excursion
(goto-char (point-min))
(let ((ret '()))
(while (search-forward-regexp "^: " nil t)
(let ((header (buffer-substring-no-properties (point) (line-end-position)))
(body '()))
(forward-line)
(while (not (looking-at "^$"))
(push (buffer-substring-no-properties (point) (line-end-position)) body)
(forward-line))
(push (cons header (list (reverse body))) ret)))
(nreverse ret))))
Here, take this Lisp code:
(defun chopchop ()
(mapcar
(lambda (x)
(destructuring-bind (head &rest tail)
(split-string x "\n" t)
(list head tail)))
(split-string (buffer-substring-no-properties
(point-min)
(point-max)) "\n?: *" t)))
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")))
Basically I want the *Messages* buffer to always scroll to the bottom when a new message arrives.
Can I do that?
I found auto-revert-tail-mode but that works for buffers that are visiting files.
When I tried it in the Messages buffer, it popped an error:
auto-revert-tail-mode: This buffer is not visiting a file
For multiple frames you probably want:
(defadvice message (after message-tail activate)
"goto point max after a message"
(with-current-buffer "*Messages*"
(goto-char (point-max))
(walk-windows (lambda (window)
(if (string-equal (buffer-name (window-buffer window)) "*Messages*")
(set-window-point window (point-max))))
nil
t)))
Just put point at the end of the buffer M->. If you don't manually move it it will stay there -- IOW, you will always see the tail.
This code seems a bit overkill, but a the simple (goto-char (point-max)) wasn't working for me:
(defadvice message (after message-tail activate)
"goto point max after a message"
(with-current-buffer "*Messages*"
(goto-char (point-max))
(let ((windows (get-buffer-window-list (current-buffer) nil t)))
(while windows
(set-window-point (car windows) (point-max))
(setq windows (cdr windows))))))
Here's an implementation that uses the new advice style.
(defun message-buffer-goto-end-of-buffer (&rest args)
(let* ((win (get-buffer-window "*Messages*"))
(buf (and win (window-buffer win))))
(and win (not (equal (current-buffer) buf))
(set-window-point
win (with-current-buffer buf (point-max))))))
(advice-add 'message :after 'message-buffer-goto-end-of-buffer)
i run 23.3 and there were still way too many occasions where the built-in 'solution' and the orginal defadvice on the message function just didn't cut it, so i wrapped that code in a list / toggle / timer set up and it's working beautifully - no more frustration when debugging!
it's generic, so works on any buffer, although i only really use it for..
(toggle-buffer-tail "*Messages*" "on")
..hope it's useful to someone.
;alist of 'buffer-name / timer' items
(defvar buffer-tail-alist nil)
(defun buffer-tail (name)
"follow buffer tails"
(cond ((or (equal (buffer-name (current-buffer)) name)
(string-match "^ \\*Minibuf.*?\\*$" (buffer-name (current-buffer)))))
((get-buffer name)
(with-current-buffer (get-buffer name)
(goto-char (point-max))
(let ((windows (get-buffer-window-list (current-buffer) nil t)))
(while windows (set-window-point (car windows) (point-max))
(with-selected-window (car windows) (recenter -3)) (setq windows (cdr windows))))))))
(defun toggle-buffer-tail (name &optional force)
"toggle tailing of buffer NAME. when called non-interactively, a FORCE arg of 'on' or 'off' can be used to to ensure a given state for buffer NAME"
(interactive (list (cond ((if name name) (read-from-minibuffer
(concat "buffer name to tail"
(if buffer-tail-alist (concat " (" (caar buffer-tail-alist) ")") "") ": ")
(if buffer-tail-alist (caar buffer-tail-alist)) nil nil
(mapcar '(lambda (x) (car x)) buffer-tail-alist)
(if buffer-tail-alist (caar buffer-tail-alist)))) nil)))
(let ((toggle (cond (force force) ((assoc name buffer-tail-alist) "off") (t "on")) ))
(if (not (or (equal toggle "on") (equal toggle "off")))
(error "invalid 'force' arg. required 'on'/'off'")
(progn
(while (assoc name buffer-tail-alist)
(cancel-timer (cdr (assoc name buffer-tail-alist)))
(setq buffer-tail-alist (remove* name buffer-tail-alist :key 'car :test 'equal)))
(if (equal toggle "on")
(add-to-list 'buffer-tail-alist (cons name (run-at-time t 1 'buffer-tail name))))
(message "toggled 'tail buffer' for '%s' %s" name toggle)))))
edit: changed functionality to display tail at the bottom of the window
Here's an amendment over Peter's / Trey's solutions
(defun modi/messages-auto-tail (&rest _)
"Make *Messages* buffer auto-scroll to the end after each message."
(let* ((buf-name "*Messages*")
;; Create *Messages* buffer if it does not exist
(buf (get-buffer-create buf-name)))
;; Activate this advice only if the point is _not_ in the *Messages* buffer
;; to begin with. This condition is required; otherwise you will not be
;; able to use `isearch' and other stuff within the *Messages* buffer as
;; the point will keep moving to the end of buffer :P
(when (not (string= buf-name (buffer-name)))
;; Go to the end of buffer in all *Messages* buffer windows that are
;; *live* (`get-buffer-window-list' returns a list of only live windows).
(dolist (win (get-buffer-window-list buf-name nil :all-frames))
(with-selected-window win
(goto-char (point-max))))
;; Go to the end of the *Messages* buffer even if it is not in one of
;; the live windows.
(with-current-buffer buf
(goto-char (point-max))))))
(advice-add 'message :after #'modi/messages-auto-tail)