Could anyone please give me a hand to briefly pop-up a dired buffer for the purposes of read-file-name:
(defun dired-insert-file ()
(interactive)
(setq filename (dired-read-file-name "~/Desktop"))
(kill-buffer dired)
(get-buffer-create "*foo*")
(set-buffer "*foo*")
(insert-file filename))
EDIT: Revised example:
(require 'dired)
(defvar open-with-variable nil)
(defvar save-as-variable nil)
(defvar save-as-buffer-filename nil)
(defun dired-read-file-name (&optional directory)
(let* (
output-filename
(working-buffer (buffer-name)))
(if directory
(dired directory)
(dired nil))
(if save-as-buffer-filename
(progn
(goto-char (point-min))
(re-search-forward (file-name-nondirectory save-as-buffer-filename) nil t)))
(recursive-edit)
(switch-to-buffer working-buffer)
output-filename))
(defun dired-insert-file ()
(interactive)
(let* (
(save-as-variable t)
(lawlist-filename (dired-read-file-name)))
(insert-file-contents lawlist-filename)))
;; Open with external application.
(define-key dired-mode-map (kbd "C-c o") (lambda () (interactive)
(let* (
(open-with-variable t)
(lawlist-filename (dired-get-file-for-visit))
(application (dired-read-file-name "/Applications")))
(start-process "external-application" nil "open" "-a" application lawlist-filename))))
(defun lawlist-save-as ()
(interactive)
(let* (
save-as-filename
(save-as-variable t)
(save-as-buffer-filename (if (buffer-file-name) (buffer-file-name)))
(proposed-filename (dired-read-file-name)))
(when proposed-filename ;; needed if aborting recursive-edit
(setq save-as-filename (read-string "Save-As: "
(if (file-directory-p proposed-filename)
(concat proposed-filename (buffer-name))
proposed-filename)))
(when (and save-as-filename (file-exists-p save-as-filename))
(or (y-or-n-p (format "File `%s' exists; overwrite? " save-as-filename))
(error "Canceled")))
(set-visited-file-name save-as-filename)
(set-buffer-modified-p t)
(and (buffer-file-name)
(file-writable-p buffer-file-name)
(setq buffer-read-only nil))
(save-buffer))))
;; delete the buffer after selecting file | application | directory
(define-key dired-mode-map (kbd "<return>") (lambda () (interactive)
(select-file-application-directory t)))
;; do not delete the buffer after selecting file | application | directory
(define-key dired-mode-map (kbd "<C-M-s-return>") (lambda () (interactive)
(select-file-application-directory nil)))
;; select file | application | directory
(defun select-file-application-directory (&optional delete-buffer)
(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 "/Applications/Microsoft Office 2011/Microsoft Word.app/Contents/MacOS/Microsoft Word")
(ooo "/Applications/OpenOffice.org.app")
(excel "/Applications/Microsoft Office 2011/Microsoft Excel.app/Contents/MacOS/Microsoft Excel")
(adobe "/Applications/Adobe Acrobat 9 Pro/Adobe Acrobat Pro.app/Contents/MacOS/AdobeAcrobat")
(preview "/Applications/Preview.app/Contents/MacOS/Preview")
(skim "/Applications/Skim.app/Contents/MacOS/Skim")
(input-regexp '("odt" "wpd" "docx" "doc" "xls" "pdf" "tif" "bmp" "jpg"))
(pdf-regexp '("pdf" "tif" "bmp" "jpg"))
(ooo-regexp '("odt" "wpd"))
(msword-regexp '("doc" "docx")))
(cond
;; only use current path a save-as situation.
((and
(equal input-filename (concat path "."))
save-as-variable)
(setq output-filename (expand-file-name default-directory))
(if delete-buffer (kill-buffer dired-buffer-name))
(throw 'exit nil))
;; save-as (stringp) | dired-insert-file
((and
(stringp input-filename)
(not (file-directory-p input-filename))
(file-exists-p input-filename)
(not (equal input-filename (concat path ".")))
save-as-variable)
(setq output-filename input-filename)
(if delete-buffer (kill-buffer dired-buffer-name))
(throw 'exit nil))
;; open just one file, except input-regexp
((and
(stringp input-filename)
(not (file-directory-p input-filename))
(file-exists-p input-filename)
(not (equal input-filename (concat path ".")))
(not save-as-variable)
(not (regexp-match-p input-regexp ext)))
(if delete-buffer (kill-buffer dired-buffer-name))
(find-file input-filename))
;; open numerous files, except input-regexp
((and
(listp input-filename)
(not (regexp-match-p input-regexp ext)))
(if delete-buffer (kill-buffer dired-buffer-name))
(mapc 'find-file input-filename))
;; open OpenOfficeOrg
((and
(stringp input-filename)
(not (file-directory-p input-filename))
(file-exists-p input-filename)
(not (equal input-filename (concat path ".")))
(not save-as-variable)
(regexp-match-p ooo-regexp ext))
(start-process "ooo-view" nil "open" "-a" ooo input-filename)
(if delete-buffer (kill-buffer dired-buffer-name)))
;; open msword
((and
(stringp input-filename)
(not (file-directory-p input-filename))
(file-exists-p input-filename)
(not (equal input-filename (concat path ".")))
(not save-as-variable)
(regexp-match-p msword-regexp ext))
(start-process "msword-view" nil "open" "-a" msword input-filename)
(if delete-buffer (kill-buffer dired-buffer-name)))
;; open excel
((and
(stringp input-filename)
(not (file-directory-p input-filename))
(file-exists-p input-filename)
(not (equal input-filename (concat path ".")))
(not save-as-variable)
(equal ext "xls"))
(start-process "excel-view" nil "open" "-a" excel input-filename)
(if delete-buffer (kill-buffer dired-buffer-name)))
;; *.pdf -- open just one *.pdf file.
((and
(stringp input-filename)
(not (file-directory-p input-filename))
(file-exists-p input-filename)
(not (equal input-filename (concat path ".")))
(not save-as-variable)
(regexp-match-p pdf-regexp ext))
(lawlist-message "[a]dobe | [p]review | [s]kim")
(let* ((select-pdf-viewer (read-char-exclusive)))
(cond
((eq select-pdf-viewer ?a)
(start-process "pdf-with-adobe" nil "open" "-a" adobe input-filename)
(if delete-buffer (kill-buffer dired-buffer-name)))
((eq select-pdf-viewer ?p)
(start-process "pdf-with-preview" nil "open" "-a" preview input-filename)
(if delete-buffer (kill-buffer dired-buffer-name)))
((eq select-pdf-viewer ?s)
(start-process "pdf-with-adobe" nil "open" "-a" skim input-filename)
(if delete-buffer (kill-buffer dired-buffer-name)))
(t (message "You have exited the sub-function.")) )) )
;; *.pdf -- open more than just one *.pdf file.
((and
(listp input-filename)
(not save-as-variable)
(regexp-match-p pdf-regexp ext))
(lawlist-message "[a]dobe | [p]review | [s]kim")
(let* ((select-pdf-viewer (read-char-exclusive)))
(cond
((eq select-pdf-viewer ?a)
(mapcar (lambda (x)
(start-process "pdf-with-adobe" nil "open" "-a" adobe x) )
input-filename)
(if delete-buffer (kill-buffer dired-buffer-name)))
((eq select-pdf-viewer ?p)
(mapcar (lambda (x)
(start-process "pdf-with-preview" nil "open" "-a" preview x) )
input-filename)
(if delete-buffer (kill-buffer dired-buffer-name)))
((eq select-pdf-viewer ?s)
(mapcar (lambda (x)
(start-process "pdf-with-adobe" nil "open" "-a" skim x) )
input-filename)
(if delete-buffer (kill-buffer dired-buffer-name)))
(t (message "You have exited the sub-function.")) )) )
;; open with external application, because the `open-with-variable` is t.
((and
open-with-variable
(equal ext "app"))
(setq output-filename input-filename)
(if delete-buffer (kill-buffer dired-buffer-name))
(throw 'exit nil))
;; Enter the directory; or, open an application
((and
(file-directory-p input-filename)
(not (equal input-filename (concat path ".")))
(not open-with-variable))
(if (equal ext "app")
(progn
(message "[d]eeper | [o]pen")
(let* ((deeper-open (read-char-exclusive)))
(cond
((eq deeper-open ?d)
(dired-find-file)
(goto-char (point-min))
(re-search-forward " \\.\\.$" nil t)
(if delete-buffer (kill-buffer dired-buffer-name)))
((eq deeper-open ?o)
(start-process "application" nil "open" "-a" input-filename)
(if delete-buffer (kill-buffer dired-buffer-name)))
(t (message "You have exited the sub-function.")) )) )
(dired-find-file)
(goto-char (point-min))
(re-search-forward " \\.\\.$" nil t)
(if delete-buffer (kill-buffer dired-buffer-name)))) )))
;; https://github.com/kentaro/auto-save-buffers-enhanced
;; `regexp-match-p` function modified by #sds on stackoverflow
;; http://stackoverflow.com/questions/20343048/distinguishing-files-with-extensions-from-hidden-files-and-no-extensions
(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)))))))
(defun lawlist-message (input)
(interactive)
(message
(propertize input 'face 'font-lock-warning-face)))
You'll want to look into recursive-edit: pop up a dired buffer in which you add a way to exit (which works by performing a (throw 'exit <value>)), and then call (recursive-edit) which will return the <value> passed to throw.
Related
I am trying to use the following keyboard test macro
(fset 'jj [?\C-c ?c ?t ?j ?j return ?\C-c ?\C-c])
to invoke this capture template definition
(setq org-capture-templates '(("t" "Todo" entry (file "~/org/j.org"))))
Note that C-c c invokes M-x org-capture.
Unfortunately, it produces the following error message:
After 0 kbd macro
iterations: byte-code: Capture abort: (wrong-type-argument stringp
(file:~/org/todo.org::*Tasks Tasks))
I have produced the backtrace show below. The org-mode configuration is
appended after the backtrace.
Debugger entered--Lisp error:
(error "Capture abort: (wrong-type-argument stringp
(file:~/org/todo.org::*Tasks Tasks))")
signal(error ("Capture abort: (wrong-type-argument stringp
(file:~/org/todo.org::*Tasks Tasks))"))
error("Capture abort: %s" (wrong-type-argument stringp
("file:~/org/todo.org::*Tasks" "Tasks")))
(condition-case error (org-capture-put :template
(org-capture-fill-template)) ((error quit) (if (get-buffer "*Capture*")
(kill-buffer "*Capture*")) (error "Capture abort: %s" error)))
(cond ((equal entry "C") (customize-variable (quote org-capture-templates)))
((equal entry "q") (error "Abort"))
(t (org-capture-set-plist entry) (org-capture-get-template)
(org-capture-put :original-buffer orig-buf
:original-file (or (buffer-file-name orig-buf)
(and (featurep (quote dired))
(car (rassq orig-buf
dired-buffers))))
:original-file-nondirectory (and (buffer-file-name
orig-buf) (file-name-nondirectory
(buffer-file-name orig-buf)))
:annotation annotation :initial initial
:return-to-wconf (current-window-configuration)
:default-time (or org-overriding-default-time
(org-current-time))$)
(org-capture-set-target-location)
(condition-case error
(org-capture-put :template (org-capture-fill-template))
((error quit)
(if (get-buffer "*Capture*") (kill-buffer "*Capture*"))
(error "Capture abort: %s" error)))
(setq org-capture-clock-keep (org-capture-get :clock-keep))
(if (equal goto 0)
(org-capture-insert-template-here)
(condition-case error
(org-capture-place-template
(equal (car (org-capture-get :target)) (quote function)))
((error quit) (if (and (buffer-base-buffer ...)
(string-match "\\`CAPTURE-" ...))
(kill-buffer (current-buffer)))
(set-window-configuration (org-capture-get :return-to-wconf))
(error "Capture template `%s': %s" (org-capture-get :key) (nth
1 error))))
(if (and (derived-mode-p (quote org-mode))
(org-capture-get :clock-in))
(condition-case nil (progn (if (org-clock-is-active)
(org-capture-put
:interrupted-clock...))
(org-clock-in) (org-set-local
(quote org-capture-clock-was-started) t))
(error "Could not start the clock in this capture buffer")))
(if (org-capture-get :immediate-finish) (org-capture-finalize)))))
(let* ((orig-buf (current-buffer))
(annotation
(if (and (boundp (quote org-capture-link-is-already-stored))
org-capture-link-is-already-stored)
(plist-get org-store-link-plist :annotation)
(condition-case nil (progn (org-store-link nil))
(error nil))))
(entry (or org-capture-entry (org-capture-select-template keys)))
initial)
(setq initial (or org-capture-initial (and (org-region-active-p)
(buffer-substring (point) (mark)))))
(if (stringp initial) (progn (remove-text-properties 0 (length initial)
(quote (read-only t)) initial)))
(if (stringp annotation) (progn (remove-text-properties 0 (length annotation)
(quote (read-only t)) annotation)))
(cond ((equal entry "C")
(customize-variable (quote org-capture-templates)))
((equal entry "q")
(error "Abort")) (t (org-capture-set-plist entry)
(org-capture-get-template)
(org-capture-put
:original-buffer orig-buf
:original-file (or (buffer-file-name orig-buf)
(and (featurep (quote dired))
(car (rassq orig-buf
dired-buffers))))
:original-file-nondirectory (and
(buffer-file-name orig-buf)
(file-name-nondirectory
(buffer-file-name orig-buf)))
:annotation annotation :initial initial
:return-to-wconf
(current-window-configuration)
:default-time (or org-overriding-default-time
(org-current-time)))
(org-capture-set-target-location)
(condition-case error
(org-capture-put :template
(org-capture-fill-template))
((error quit)
(if (get-buffer "*Capture*")
(kill-buffer "*Capture*"))
(error "Capture abort: %s" error)))
(setq org-capture-clock-keep (org-capture-get
:clock-keep))
(if (equal goto 0)
(org-capture-insert-template-here)
(condition-case error
(org-capture-place-template (equal (car ...) (quote function)))
((error quit) (if (and ... ...)
(kill-buffer ...))
(set-window-configuration (org-capture-get
:return-to-wconf))
(error "Capture template `%s': %s"
(org-capture-get :key) (nth 1 error))))
(if (and (derived-mode-p (quote org-mode))
(org-capture-get :clock-in))
(condition-case nil (progn (if ... ...)
(org-clock-in) (org-set-local ... t))
(error "Could not start the clock in
this capture buffer")))
(if (org-capture-get :immediate-finish)
(org-capture-finalize))))))
(cond ((equal goto (quote (4))) (org-capture-goto-target))
((equal goto (quote (16))) (org-capture-goto-last-stored))
(t (let* ((orig-buf (current-buffer))
(annotation (if (and (boundp ...)
org-capture-link-is-already-stored)
(plist-get org-store-link-plist :annotation)
(condition-case nil (progn ...) (error nil))))
(entry (or org-capture-entry
(org-capture-select-template keys))) initial)
(setq initial (or org-capture-initial
(and (org-region-active-p)
(buffer-substring (point) (mark)))))
(if (stringp initial)
(progn
(remove-text-properties 0 (length initial)
(quote (read-only t)) initial)))
(if (stringp annotation)
(progn (remove-text-properties 0 (length annotation)
(quote (read-only t))
annotation)))
(cond ((equal entry "C") (customize-variable (quote
org-capture-templates)))
((equal entry "q")
(error "Abort"))
(t (org-capture-set-plist entry) (org-capture-get-template)
(org-capture-put
:original-buffer orig-buf
:original-file (or (buffer-file-name orig-buf) (and ...
...))
:original-file-nondirectory (and (buffer-file-name
orig-buf) (file-name-nondirectory ...))
:annotation annotation
:initial initial
:return-to-wconf (current-window-configuration)
:default-time (or org-overriding-default-time
(org-current-time)))
(org-capture-set-target-location)
(condition-case error (org-capture-put
:template
(org-capture-fill-template))
((error quit) (if ... ...)
(error "Capture abort: %s" error)))
(setq org-capture-clock-keep
(org-capture-get :clock-keep))
(if (equal goto 0)
(org-capture-insert-template-here)
(condition-case error (org-capture-place-template ...)
(... ... ... ...))
(if (and ... ...) (condition-case nil ... ...))
(if (org-capture-get :immediate-finish)
(org-capture-finalize))))))))
org-capture(nil)
call-interactively(org-capture nil nil)
command-execute(jj record)
execute-extended-command(nil "jj")
call-interactively(execute-extended-command nil nil)
----------------------------------------------------
ORG-MODE CONFIGURATION
Emacs : GNU Emacs 24.3.1 (i686-pc-linux-gnu, GTK+ Version 3.4.2)
of 2014-02-22 on chindi10, modified by Debian
Package: Org-mode version 8.2.10 (8.2.10-dist <at> /usr/share/emacs/site-lisp/org/)
current state:
==============
(setq
org-ctrl-c-ctrl-c-hook '(org-babel-hash-at-point
org-babel-execute-safely-maybe)
org-tab-first-hook '(org-hide-block-toggle-maybe
org-src-native-tab-command-maybe org-babel-hide-result-toggle-maybe
org-babel-header-arg-expand)
org-agenda-use-time-grid nil
org-cycle-hook '(org-cycle-hide-archived-subtrees org-cycle-hide-drawers
org-cycle-hide-inline-tasks org-cycle-show-empty-lines
org-optimize-window-after-visibility-change)
org-agenda-custom-commands '(("pa" "A-priority" tags-todo
"+SCHEDULED<=\"<today>\"+PRIORITY=\"A\"") ("pb" "B-priority"
tags-todo
"+SCHEDULED<=\"<today>\"+PRIORITY=\"B\"")
("pc" "C-priority" tags-todo
"+SCHEDULED<=\"<today>\"+PRIORITY=\"C\"") ("b" "Buy" tags
"+CATEGORY=\"BUY\"")
("w" "Web" tags "+CATEGORY=\"WEB\"") ("k"
"Books" tags "+CATEGORY=\"BOOKS\"")
("v" "Movies" tags "+CATEGORY=\"MOVIES\"")
("u" "Music" tags "+CATEGORY=\"MUSIC\""))
org-agenda-before-write-hook '(org-agenda-add-entry-text)
org-speed-command-hook '(org-speed-command-default-hook
org-babel-speed-command-hook)
org-babel-pre-tangle-hook '(save-buffer)
org-occur-hook '(org-first-headline-recenter)
org-deadline-warning-days 0
org-metaup-hook '(org-babel-load-in-session-maybe)
org-confirm-elisp-link-function 'yes-or-no-p
org-capture-templates '(("t" "Todo" entry (file "~/org/j.org")))
org-agenda-sorting-strategy '((agenda priority-down) (todo priority-down
category-keep) (tags priority-down category-keep) (search category-keep))
org-agenda-start-with-follow-mode t
org-clock-out-hook '(org-clock-remove-empty-clock-drawer)
org-agenda-prefix-format " %-11:c% s"
org-mode-hook '(#[nil "\300\301\302\303\304$\207" [org-add-hook
change-major-mode-hook org-show-block-all append local]
5]
#[nil "\300\301\302\303\304$\207" [org-add-hook
change-major-mode-hook org-babel-show-result-all append local] 5]
org-babel-result-hide-spec org-babel-hide-all-hashes my-org-mode-hook)
org-agenda-start-on-weekday nil
org-agenda-mode-hook '(my-org-agenda-mode-hook)
org-directory "~/org/"
org-metadown-hook '(org-babel-pop-to-session-maybe)
org-agenda-files '("~/org/todo.org" "~/org/home.org")
org-src-mode-hook '(org-src-babel-configure-edit-buffer
org-src-mode-configure-edit-buffer)
org-after-todo-state-change-hook '(org-clock-out-if-current)
org-confirm-shell-link-function 'yes-or-no-p
)
Short: executing-kbd-macro in org-store-link is the reason. I couldn't come up with a simple solution.
I tried to reproduce this error and found that function
(defun test-inside-kbd-macro ()
(interactive)
(print (ignore-errors (org-store-link nil))))
gives different results depending on way to run. 1) M-x test-inside-kbd-macro
gives "[[file:~/git/org/refile.org::*kbd%20capture][kbd capture]]" (string), but 2)
(execute-kbd-macro (read-kbd-macro "M-x test-inside-kbd-macro RET"))
gives ("file:~/git/org/refile.org::*kbd capture" "kbd capture") (list). So the error (wrong-type-argument stringp ...) occurs due to this.
If you see code of the function org-store-link(the last 10 lines)
;; Return the link
(if (not (and (or (org-called-interactively-p 'any)
executing-kbd-macro) link))
(or agenda-link (and link (org-make-link-string link desc)))
(push (list link desc) org-stored-links)
(message "Stored: %s" (or desc link))
(when custom-id
(setq link (concat "file:" (abbreviate-file-name
(buffer-file-name)) "::#" custom-id))
(push (list link desc) org-stored-links))
(car org-stored-links))))))
you will find that in the 1) case the value of the function test-inside-kbd-macro is created using (org-make-link-string link desc) and in the 2) case - using (car org-stored-links).
I think this is due to executing-kbd-macro in if section.
org-capture:
annotation -> (ignore-errors (org-store-link nil))
(org-capture-put ...
:annotation annotation ...)
org-capture-fill-template:
(v-a (or (plist-get org-store-link-plist :annotation)
annotation
(org-capture-get :annotation)
""))
(v-A (if (and v-a (string-match l-re v-a))
generates the error.
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)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Is there a select region function that will preserve the selection if the region scrolls out of sight?
There are two kinds of selected region that I use on a daily basis. The first kind is with the shift key using an interactive code "^" in various movement functions -- e.g., left or right. The second kind is set-mark-command. In the first case, the highlighted region is deselected when I scroll up or down. In the second case, the highlighted region changes / moves if the selected region touches the top or bottom of the window when scrolling.
Ideally, I would like to select a region and then be free to move around the buffer from point-min to point-max.
I do not think there is such a function. The thing is emacs moves the point on scrolling (when the point moves out of window) that is why the selected region changes. See this question
That looks promising:
https://sites.google.com/site/steveyemacsutils/multi-select-el
There is also a multi-region.el at emacswiki.org
INITIAL (March 4, 2014): First rough draft. lawlist-mwheel-scroll is a modification of mwheel-scroll within mwheel.el -- the primary modification was to remove (let ((newpoint (point))) (goto-char opoint) (deactivate-mark) (goto-char newpoint)) and replace it with a fixed overlay based upon region-begin and region-end immediately before scrolling up or down.
EDIT (March 5, 2014): Revised lawlist-mwheel-scroll to behave more like mwheel-scroll was originally intended within mwheel.el. Because regions can be selected from left to right, or from right to left, the original-point could be on either side of the selected region. Therefore, region-begin and region-end are not used to calculate whether the point has moved -- we use original-point and compare it to the potential new (point) after scrolling has occurred. Consolidated the contents of the prior function lawlist-select-region into the function lawlist-activate-deactivate-mark such that the former is no longer used.
(global-set-key (kbd "C-c c") 'lawlist-copy-selected-region)
(global-set-key (kbd "C-SPC") 'lawlist-activate-deactivate-mark)
(global-set-key [(wheel)] 'lawlist-mwheel-scroll)
(global-set-key [(wheel-down)] 'lawlist-mwheel-scroll)
(global-set-key [(wheel-up)] 'lawlist-mwheel-scroll)
(defvar region-begin nil
"The beginning of the selected region.")
(make-variable-buffer-local 'region-begin)
(defvar region-end nil
"The ending of the selected region.")
(make-variable-buffer-local 'region-end)
(defun lawlist-activate-deactivate-mark ()
(interactive)
(cond
;; newly selected region -- no prior overlay
((and
(region-active-p)
(not region-begin)
(not region-end))
(setq region-begin (region-beginning))
(setq region-end (region-end))
(overlay-put (make-overlay region-begin region-end) 'priority 1001)
(overlay-put (make-overlay region-begin region-end) 'face isearch-face)
(deactivate-mark t))
;; prior overlay + newly selected region
((and
(region-active-p)
region-begin
region-end)
(mapc 'delete-overlay (overlays-in region-begin region-end))
(setq region-begin (region-beginning))
(setq region-end (region-end))
(overlay-put (make-overlay region-begin region-end) 'priority 1001)
(overlay-put (make-overlay region-begin region-end) 'face isearch-face)
(deactivate-mark t))
;; prior overlay -- no selected region -- inside of overlay
((and
(not (region-active-p))
region-begin
region-end
(and
(>= (point) region-begin)
(<= (point) region-end)))
(message "[b]egin | [e]nd | [c]urrent | [d]eactivate")
(let* ((extend-region (read-char-exclusive)))
(cond
((eq extend-region ?b)
(set-marker (mark-marker) region-begin (current-buffer))
(setq mark-active t))
((eq extend-region ?e)
(set-marker (mark-marker) region-end (current-buffer))
(setq mark-active t))
((eq extend-region ?c)
(set-marker (mark-marker) (point) (current-buffer))
(setq mark-active t))
((eq extend-region ?d)
(deactivate-mark t))))
(mapc 'delete-overlay (overlays-in region-begin region-end)))
;; prior overlay -- no selected region -- outside of overlay
((and
(not (region-active-p))
region-begin
region-end
(or
(< (point) region-begin)
(> (point) region-end)))
(mapc 'delete-overlay (overlays-in region-begin region-end))
(setq region-begin nil)
(setq region-end nil)
(deactivate-mark t))
(t
(set-mark-command nil))))
(defun lawlist-copy-selected-region ()
(interactive)
(cond
;; prior overlay + newly selected region
((and
(region-active-p)
region-begin
region-end)
(mapc 'delete-overlay (overlays-in region-begin region-end))
(setq region-begin (region-beginning))
(setq region-end (region-end)))
;; prior overlay + no region selected
((and
(not (region-active-p))
region-begin
region-end)
(mapc 'delete-overlay (overlays-in region-begin region-end)))
;; newly selected region -- no prior overlay
((and
(region-active-p)
(not region-begin)
(not region-end))
(setq region-begin (region-beginning))
(setq region-end (region-end))) )
(if (and region-begin region-end)
(progn
(copy-region-as-kill region-begin region-end)
(message "copied: %s"
(concat
(truncate-string-to-width
(buffer-substring-no-properties region-begin region-end)
40)
(if
(>
(length
(buffer-substring-no-properties region-begin region-end))
40)
" . . ."
"")))
(setq region-begin nil)
(setq region-end nil))
(message "To copy, you must first select a region.")))
(defun lawlist-mwheel-scroll (event)
"Scroll up or down according to the EVENT.
This should only be bound to mouse buttons 4 and 5."
(interactive (list last-input-event))
(let* (
(curwin
(if mouse-wheel-follow-mouse
(prog1
(selected-window)
(select-window (mwheel-event-window event)))))
(buffer (window-buffer curwin))
(original-point
(with-current-buffer buffer
(when (eq (car-safe transient-mark-mode) 'only)
(point))))
(mods
(delq 'click (delq 'double (delq 'triple (event-modifiers event)))))
(amt (assoc mods mouse-wheel-scroll-amount)))
(with-current-buffer buffer
(when (eq (car-safe transient-mark-mode) 'only)
(setq region-begin (region-beginning))
(setq region-end (region-end))))
(if amt (setq amt (cdr amt))
(let ((list-elt mouse-wheel-scroll-amount))
(while (consp (setq amt (pop list-elt))))))
(if (floatp amt) (setq amt (1+ (truncate (* amt (window-height))))))
(when (and mouse-wheel-progressive-speed (numberp amt))
(setq amt (* amt (event-click-count event))))
(unwind-protect
(let ((button (mwheel-event-button event)))
(cond
((eq button mouse-wheel-down-event)
(condition-case nil (funcall mwheel-scroll-down-function amt)
(beginning-of-buffer
(unwind-protect
(funcall mwheel-scroll-down-function)
(set-window-start (selected-window) (point-min))))))
((eq button mouse-wheel-up-event)
(condition-case nil (funcall mwheel-scroll-up-function amt)
(end-of-buffer (while t (funcall mwheel-scroll-up-function)))))
(t (error "Bad binding in mwheel-scroll"))))
(if curwin (select-window curwin)))
(with-current-buffer buffer
(when
(and
original-point
(/= (point) original-point))
(overlay-put (make-overlay region-begin region-end) 'priority 1001)
(overlay-put (make-overlay region-begin region-end) 'face isearch-face)
(deactivate-mark t) )))
(when (and mouse-wheel-click-event mouse-wheel-inhibit-click-time)
(if mwheel-inhibit-click-event-timer
(cancel-timer mwheel-inhibit-click-event-timer)
(add-hook 'pre-command-hook 'mwheel-filter-click-events))
(setq mwheel-inhibit-click-event-timer
(run-with-timer mouse-wheel-inhibit-click-time nil
'mwheel-inhibit-click-timeout))))
(put 'lawlist-mwheel-scroll 'scroll-command t)
I'm having difficulty distinguishing files with extensions, from files without extensions, and hidden files. I'm using (file-name-extension (dired-get-file-for-visit)) in dired-mode, and the type of file extension determines what action to take -- e.g., open in Emacs, or open externally with a particular application.
A hidden file (e.g., .hidden) returns a value of nil instead of "hidden".
A file with no extension (e.g., foo) also returns a value of nil.
Can anyone suggest an alternative method to handle this?
(let* (
(input-regexp '("odt" "wpd" "docx" "doc" "xls" "pdf" "tif" "bmp" "jpg"))
(input-filename (dired-get-file-for-visit)) )
(if (not (regexp-match-p input-regexp (file-name-extension input-filename))))
(find-file input-filename) )
;; https://github.com/kentaro/auto-save-buffers-enhanced
(defun regexp-match-p (regexps string)
(catch 'matched
(dolist (regexp regexps)
(if (string-match regexp string)
(throw 'matched t)))))
Here is the debugger (partial):
Debugger entered--Lisp error: (wrong-type-argument stringp nil)
string-match("odt" nil)
(if (string-match regexp string) (throw (quote matched) t))
(while --dolist-tail-- (setq regexp (car --dolist-tail--)) (if (string-match regexp string) (throw (quote matched) t)) (setq --dolist-tail-- (cdr --dolist-tail--)))
(let ((--dolist-tail-- regexps) regexp) (while --dolist-tail-- (setq regexp (car --dolist-tail--)) (if (string-match regexp string) (throw (quote matched) t)) (setq --dolist-tail-- (cdr --dolist-tail--))))
(progn (let ((--dolist-tail-- regexps) regexp) (while --dolist-tail-- (setq regexp (car --dolist-tail--)) (if (string-match regexp string) (throw (quote matched) t)) (setq --dolist-tail-- (cdr --dolist-tail--)))))
(catch (quote matched) (progn (let ((--dolist-tail-- regexps) regexp) (while --dolist-tail-- (setq regexp (car --dolist-tail--)) (if (string-match regexp string) (throw (quote matched) t)) (setq --dolist-tail-- (cdr --dolist-tail--))))))
regexp-match-p(("odt" "wpd" "docx" "doc" "xls" "pdf" "tif" "bmp" "jpg") nil)
(not (regexp-match-p input-regexp (file-name-extension input-filename)))
***
How about
(let* ((input-regexp '("odt" "wpd" "docx" "doc" "xls" "pdf" "tif" "bmp" "jpg"))
(input-filename (dired-get-file-for-visit))
(ext (file-name-extension input-filename)))
(unless (and ext (regexp-match-p input-regexp ext))
(find-file input-filename)))
Alternatively, redefine
(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)))))))
The existing code written by Rupert Swarbrick, later modified by Rory Yorke, still leaves open the need to specify the file location with a save-as function (e.g. on OSX, this would be ns-write-file-using-panel). Does anyone have a suggestion, please, that adds an option similar to ns-write-file-using-panel and/or perhaps modifies the /tmp directory option written in the script?
Word wrap for Emacs print buffer to PDF
Formatting a header in an Emacs function to print a buffer to PDF w/ line wrapping
(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 spool-buffer-given-name (name)
(let ((ps-left-header (list (format "(%s)" name))))
(ps-spool-buffer-with-faces)))
(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)
(visual-line-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")))
You can modify the last function to take a filename as a parameter:
(defun print-to-pdf (pdf-file-name)
"Print the current file to the given file."
(interactive "FWrite PDF file: ")
(let ((ps-file-name (concat (file-name-sans-extension pdf-file-name) ".ps"))
(wbuf (generate-new-buffer "*Wrapped*"))
(sbuf (current-buffer)))
(jit-lock-fontify-now)
(save-current-buffer
(set-buffer wbuf)
(insert-buffer sbuf)
(setq fill-column 95)
(longlines-mode t)
(harden-newlines)
(message (buffer-name sbuf))
(spool-buffer-given-name (buffer-name sbuf))
(kill-buffer wbuf)
(switch-to-buffer "*PostScript*")
(write-file ps-file-name t)
(kill-buffer (current-buffer)))
(call-process "ps2pdf14" nil nil nil ps-file-name pdf-file-name)
(delete-file ps-file-name)
(message "PDF saved to %s" pdf-file-name)))
You might want to add some code that tests if the PDF file already exist though, to avoid overwriting anything.