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)))
Related
In elisp, how can I get a destructuring bind for regex matches?
For example,
;; what is the equivalent of this with destructuring?
(with-temp-buffer
(save-excursion (insert "a b"))
(re-search-forward "\\(a\\) \\(b\\)")
(cons (match-string 1)
(match-string 2)))
;; trying to do something like the following
(with-temp-buffer
(save-excursion (insert "a b"))
(cl-destructuring-bind (a b) (re-search-forward "\\(a\\) \\(b\\)")
(cons a b)))
I was thinking I would have to write a macro to expand matches if there isn't another way.
Here is one way: you first extend pcase to accept a new re-match pattern, with a definition such as:
(pcase-defmacro re-match (re)
"Matches a string if that string matches RE.
RE should be a regular expression (a string).
It can use the special syntax \\(?VAR: to bind a sub-match
to variable VAR. All other subgroups will be treated as shy.
Multiple uses of this macro in a single `pcase' are not optimized
together, so don't expect lex-like performance. But in order for
such optimization to be possible in some distant future, back-references
are not supported."
(let ((start 0)
(last 0)
(new-re '())
(vars '())
(gn 0))
(while (string-match "\\\\(\\(?:\\?\\([-[:alnum:]]*\\):\\)?" re start)
(setq start (match-end 0))
(let ((beg (match-beginning 0))
(name (match-string 1 re)))
;; Skip false positives, either backslash-escaped or within [...].
(when (subregexp-context-p re start last)
(cond
((null name)
(push (concat (substring re last beg) "\\(?:") new-re))
((string-match "\\`[0-9]" name)
(error "Variable can't start with a digit: %S" name))
(t
(let* ((var (intern name))
(id (cdr (assq var vars))))
(unless id
(setq gn (1+ gn))
(setq id gn)
(push (cons var gn) vars))
(push (concat (substring re last beg) (format "\\(?%d:" id))
new-re))))
(setq last start))))
(push (substring re last) new-re)
(setq new-re (mapconcat #'identity (nreverse new-re) ""))
`(and (pred stringp)
(app (lambda (s)
(save-match-data
(when (string-match ,new-re s)
(vector ,#(mapcar (lambda (x) `(match-string ,(cdr x) s))
vars)))))
(,'\` [,#(mapcar (lambda (x) (list '\, (car x))) vars)])))))
and once that is done, you can use it as follows:
(pcase X
((re-match "\\(?var:[[:alpha:]]*\\)=\\(?val:.*\\)")
(cons var val)))
or
(pcase-let
(((re-match "\\(?var:[[:alpha:]]*\\)=\\(?val:.*\\)") X))
(cons var val))
This has not been heavily tested, and as mentioned in the docstring it doesn't work as efficiently as it (c|sh)ould when matching a string against various regexps at the same time. Also you only get the matched substrings, not their position. And finally, it applies the regexp search to a string, whereas in manny/most cases regexps searches are used in a buffer. But you may still find it useful.
I am looking for some guidance, please, to reduce the time needed to perform my custom overlay removal function. The delay of up to 0.1 seconds is caused because a plethora of variables all have values, however, not every variable is necessarily used.
My goal is to attach a second variable that can be set to non-nil whenever the first variable is used, but I am unsure how to set this up and how to incorporate that into the overlay removal function.
Perhaps something that looks like this would be useful:
if (variable-one . t), then (remove-overlays (point-min) (point-max) 'display character)
In the following example, M-x sub-char-mode will place an overlay over the characters 1, 2 or 3 whenever the cursor is visiting any of those characters:
1 will become |1
2 will become |2
3 will become |3
(defvar variable-one (concat
(propertize (char-to-string ?\u007C)
'face 'font-lock-warning-face
'cursor t)
(propertize "1" 'face 'highlight 'cursor t) ))
(defvar variable-one-p (cons variable-one nil))
(defvar variable-two (concat
(propertize (char-to-string ?\u007C)
'face 'font-lock-warning-face
'cursor t)
(propertize "2" 'face 'highlight 'cursor t) ))
(defvar variable-two-p (cons variable-two nil))
(defvar variable-three (concat
(propertize (char-to-string ?\u007C)
'face 'font-lock-warning-face
'cursor t)
(propertize "3" 'face 'highlight 'cursor t) ))
(defvar variable-three-p (cons variable-three nil))
(defun substitute-character ()
(cond
((eq (char-after (point)) 49)
(setq variable-one-p (cons variable-one t))
(overlay-put (make-overlay (point) (1+ (point))) 'display variable-one))
((eq (char-after (point)) 50)
(setq variable-two-p (cons variable-two t))
(overlay-put (make-overlay (point) (1+ (point))) 'display variable-two))
((eq (char-after (point)) 51)
(setq variable-three-p (cons variable-three t))
(overlay-put (make-overlay (point) (1+ (point))) 'display variable-three))))
(defun remove-sub-char ()
(dolist (character `(
,variable-one
,variable-two
,variable-three))
(remove-overlays (point-min) (point-max) 'display character))
(dolist (my-variable `(
,variable-one-p
,variable-two-p
,variable-three-p))
(setq my-variable nil)) )
(defun sub-char-post-command-hook ()
(remove-sub-char)
(substitute-character))
(define-minor-mode sub-char-mode
"A minor-mode for testing overlay-removal with cons cells."
:init-value nil
:lighter " OV-REMOVE"
:keymap nil
:global nil
:group 'lawlist
(cond
(sub-char-mode
(add-hook 'post-command-hook 'sub-char-post-command-hook nil t)
(message "Turned ON `sub-char-mode`."))
(t
(remove-hook 'post-command-hook 'sub-char-post-command-hook t)
(remove-sub-char)
(message "Turned OFF `sub-char-mode`."))))
Apologies for pasting this image here - feel free to remove it. But I couldn't paste it into a comment, to reply to your comment asking for the appearance. This is vline-style = compose and col-highlight-vline-face-flag = nil:
First Draft (August 24, 2014): The first draft answer defines the variables as a cons cell -- the car is a predetermined overlay string, and the cdr is nil. When the cursor visits the characters 1, 2 or 3, an overlay is placed on top of those characters and the cdr of the applicable cons cell is set to t by using setcdr. The overlay removal function contains a list of variable names and the corresponding cons cells -- when the cdr of the cons cell is non-nil (i.e., t), the overlay is removed, and the cdr of the applicable cons cell is set back to nil using setcdr. The advantage of this type of setup is that the overlay removal function will quickly look at and then skip over variables whose cons cell cdr is nil -- thus saving a substantial amount of time when dealing with large quantities of variables with predetermined overlay strings.
EDIT (August 26, 2014): Modified code to permit using the same variable names in different buffers and set buffer-local values. Related threads are: How to use `setcdr` with buffer-local variables and Incorporate variable name into `dolist` cycle and change its value .
(defvar variable-one
(cons
(concat
(propertize (char-to-string ?\u007C)
'face 'font-lock-warning-face
'cursor t)
(propertize "1" 'face 'highlight 'cursor t) )
nil))
(make-variable-buffer-local 'variable-one)
(defvar variable-two
(cons
(concat
(propertize (char-to-string ?\u007C)
'face 'font-lock-warning-face
'cursor t)
(propertize "2" 'face 'highlight 'cursor t) )
nil))
(make-variable-buffer-local 'variable-two)
(defvar variable-three
(cons
(concat
(propertize (char-to-string ?\u007C)
'face 'font-lock-warning-face
'cursor t)
(propertize "3" 'face 'highlight 'cursor t) )
nil))
(make-variable-buffer-local 'variable-three)
(defun sub-char ()
(cond
((eq (char-after (point)) 49)
(let ((newlist (copy-list variable-one)))
(setcdr newlist t)
(setq-local variable-one newlist)
(overlay-put (make-overlay (point) (1+ (point))) 'display (car variable-one))))
((eq (char-after (point)) 50)
(let ((newlist (copy-list variable-two)))
(setcdr newlist t)
(setq-local variable-two newlist)
(overlay-put (make-overlay (point) (1+ (point))) 'display (car variable-two))))
((eq (char-after (point)) 51)
(let ((newlist (copy-list variable-three)))
(setcdr newlist t)
(setq-local variable-three newlist)
(overlay-put (make-overlay (point) (1+ (point))) 'display (car variable-three))))))
(defun remove-sub-char ()
(dolist (character `(
(variable-one ,variable-one)
(variable-two ,variable-two)
(variable-three ,variable-three)))
(when (cdr (car (cdr character)))
(let* (
(var (car character))
(newlist (copy-list (car (cdr character)))) )
(remove-overlays (point-min) (point-max) 'display (car (car (cdr character))))
(setcdr newlist nil)
(set (car character) newlist)
(message "var1: %s | var2: %s | var3: %s" variable-one variable-two variable-three) ))))
(defun sub-char-post-command-hook ()
(remove-sub-char)
(sub-char))
(define-minor-mode sub-char-mode
"A minor-mode for testing overlay-removal with cons cells."
:init-value nil
:lighter " OV-REMOVE"
:keymap nil
:global nil
:group 'lawlist
(cond
(sub-char-mode
(add-hook 'post-command-hook 'sub-char-post-command-hook nil t)
(message "Turned ON `sub-char-mode`."))
(t
(remove-hook 'post-command-hook 'sub-char-post-command-hook t)
(remove-sub-char)
(message "Turned OFF `sub-char-mode`."))))
I suggest you start by getting rid of your variable-FOO-p vars: not only their names are wrong (the "-p" suffix is meant for use with predicates which are necessarily functions, and not variables) but they're unneeded. Rather than tell remove-overlays to remove all overlays with a particular display property, just add a property of your own (e.g. (overlay-put <youroverlay> 'vline t)) so you can then do a single (remove-overlays (point-min) (point-max) 'vline t). Of course, another approach which will work at least as well is to keep a single buffer-local variable (better yet, window-local) which holds a list of all the overlays you currently have placed. This way, you can remove those overlays with a single (mapc #'delete-overlay vline--overlays), which is more efficient. It can be made even more efficient by moving/reusing those overlays rather than deleting them and then creating new ones instead.
How do I generate an enumerated list of all tags (e.g., :tag:) in an org-mode file? Say I have a list of the form:
* Head1 :foo:bar:
** Subhead1 :foo:
* Head2
** Subhead2 :foo:bar:
I want to generate a list of all tags in this file as well as how many times each tag was used. Say something like,
:foo: 3
:bar: 2
Here is a shorter version.
(defun get-tag-counts ()
(let ((all-tags '()))
(org-map-entries
(lambda ()
(let ((tag-string (car (last (org-heading-components)))))
(when tag-string
(setq all-tags
(append all-tags (split-string tag-string ":" t)))))))
;; now get counts
(loop for tag in (-uniq all-tags)
collect (cons tag (cl-count tag all-tags :test 'string=)))))
I could not make use of the code posted by John Kitchin, as it requires an interactive function. bpalmer from IRC freenode/#emacs was so kind to help me out. Please find a working example that spits out all tags below the respective tree.
; use this in order to be able to use loop on its own
(require 'cl)
;; count tags (see John's answer)
(defun get-tag-counts ()
(let ((all-tags '()))
(org-map-entries
(lambda ()
(let ((tag-string (car (last (org-heading-components)))))
(when tag-string
(setq all-tags
(append all-tags (split-string tag-string ":" t)))))))
;; now get counts
(loop for tag in (seq-uniq all-tags)
collect (cons tag (cl-count tag all-tags :test 'string=)))))
;; wrap get-tag-counts in an interactive function
(defun create-tag-counts-buffer ()
(interactive)
(let ((tags (get-tag-counts)) (b (get-buffer-create "*Org Tag Count*")))
(dolist (tag tags) (insert (car tag)) (insert "\n")) (display-buffer b)))
Here is an approach.
(setq my-hash (make-hash-table :test 'equal))
(org-map-entries
(lambda ()
(let ((tag-string (car (last (org-heading-components))))
(current-count))
(when tag-string
(dolist (tag (split-string tag-string ":" t))
(setq current-count (gethash tag my-hash))
(if current-count;
(puthash tag (+ 1 current-count) my-hash)
(puthash tag 1 my-hash))
)
)
)
)
)
;; https://github.com/Wilfred/ht.el
(require 'ht)
(ht-map
(lambda (key value)
(list key value))
my-hash)
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?
Here's my extension to dabbrev-expand to support sub-string expansion.It works as expected, as far as I know. However I would find it even more useful if it supported in-symbol expansion similar to the behaviour of mdabbrev, which, by the way, is incomplete in terms of symbol-character and case-adjustment support. The pattern argument to dabbrev-substring-search, however, is only the pattern before point but for in-place expansions we need the pattern after point aswell. Why isn't this pattern available in hippie/dabbrev-expand and is there a preferred way to query it?
(defun dabbrev-substring-search (pattern &optional reverse limit syntax-context)
"Expand dabbrev substring. See:
http://www.emacswiki.org/cgi-bin/wiki/HippieExpand#toc5"
(let ((result ())
(regpat (cond ((not hippie-epxand-dabbrev-as-symbol)
(concat (regexp-quote pattern) W*))
;; ((eq (char-syntax (aref pattern 0)) ?_)
;; (concat (regexp-quote pattern)
;; "\\(\\sw\\|\\s_\\)*"))
(t
(concat "\\(?:"
Y<
"\\(" "\\(?:\\sw\\|\\s_\\)+" "\\)"
"\\(" (regexp-quote pattern) "\\)"
"\\(" "\\(?:\\sw\\|\\s_\\)*" "\\)"
Y>
"\\)"
"\\|"
"\\(?:"
Y<
"\\(" "\\(?:\\sw\\|\\s_\\)*" "\\)"
"\\(" (regexp-quote pattern) "\\)"
"\\(" "\\(?:\\sw\\|\\s_\\)+" "\\)"
Y>
"\\)"
)))))
(while (and (not result)
(if reverse
(re-search-backward regpat limit t)
(re-search-forward regpat limit t)))
(setq result (buffer-substring-no-properties (save-excursion
(goto-char (match-beginning 0))
;;(skip-syntax-backward "w_")
(point))
(match-end 0)))
(if (he-string-member result he-tried-table t)
(setq result nil))) ; ignore if bad prefix or already in table
(when nil
(when result
(let* ((p (point))
(end3 (match-end 3))
(beg2 (match-end 2))
(end2 (match-end 2))
(dummy (message "%s %s %s" end3 beg2 end2))
(beg (- end3 beg2)) ;begin offset from point
(end (- end3 end2))) ;end offset from point
(setq dabbrev-substring-match-region (cons beg end))
(hictx-generic (- p beg) (- p end) nil 'match 3))))
result))
;; Use: (dabbrev-substring-search "he")
(defun try-expand-dabbrev-substring-visible (old)
"Like `try-expand-dabbrev' but for visible part of buffer."
(interactive "P")
(let ((old-fun (symbol-function 'he-dabbrev-search)))
(fset 'he-dabbrev-search (symbol-function 'dabbrev-substring-search))
(unwind-protect (try-expand-dabbrev-visible old)
(fset 'he-dabbrev-search old-fun))))
(defun try-expand-dabbrev-substring (old)
"Like `try-expand-dabbrev' but for substring match."
(interactive "P")
(let ((old-fun (symbol-function 'he-dabbrev-search)))
(fset 'he-dabbrev-search (symbol-function 'dabbrev-substring-search))
(unwind-protect (try-expand-dabbrev old)
(fset 'he-dabbrev-search old-fun))))
(defun try-expand-dabbrev-substring-all-buffers (old)
"Like `try-expand-dabbrev-all-buffers' but for substring match."
(interactive "P")
(let ((old-fun (symbol-function 'he-dabbrev-search)))
(fset 'he-dabbrev-search (symbol-function 'dabbrev-substring-search))
(unwind-protect (try-expand-dabbrev-all-buffers old)
(fset 'he-dabbrev-search old-fun))))
which is activated for example using
(setq hippie-expand-try-functions-list
(append
'(
try-expand-dabbrev-substring-visible
try-expand-dabbrev-substring
try-expand-dabbrev-substring-all-buffers)))
This might or might not help. Like ordinary dabbrev, it works with the text before point, but candidate matching can be substring, regexp, or fuzzy (various kinds), in addition to prefix. Icicles - Dynamic Abbreviation