Asking emacs for default directory path "once" - emacs

I want to have a variable that keeps the default directory a user enters and keep using it throughout the run of emacs.
Basically, when the user executes a custom command, the prompt will ask for a default directory path to execute the command (only once) and whenever the user calls the same command emacs uses the same path onward.
How can I program that snippet of code in lisp?
I basically want this code in the igrep library to accept the input from user once and not ask again:
(defvar default-files-string-new "*.[sch]")
(defun igrep-read-files (&optional prompt-prefix)
"Read and return a file name pattern from the minibuffer.
If `current-prefix-arg' is '(16) or '(64), read multiple file name
patterns and return them in a list. Optional PROMPT-PREFIX is
prepended to the \"File(s): \" prompt."
(let* ((default-files (igrep-default-files))
(default-files-string (mapconcat 'identity default-files " "))
(insert-default-directory igrep-insert-default-directory)
(file (igrep-read-file-name
(igrep-prefix prompt-prefix
(if default-files
(format "File(s) [default: %s]: "
default-files-string)
"File(s): "))
nil (if default-files default-files-string "") nil nil
'igrep-files-history))
(files (list file)))
(if (or igrep-read-multiple-files
(and (consp current-prefix-arg)
(memq (prefix-numeric-value current-prefix-arg)
'(16 64))))
(let* ((key (igrep-default-key 'exit-minibuffer
minibuffer-local-completion-map
"\r"))
(prompt
(igrep-prefix prompt-prefix
(if igrep-verbose-prompts
(format "File(s): [Type `%s' when done] "
(key-description key))
"File(s): "))))
(while (and (setq file
(igrep-read-file-name prompt
nil "" nil nil
'igrep-files-history))
(not (equal file "")))
(setq files (cons file files)))))
(mapcar (lambda (file)
(if (file-directory-p file)
;; really should map expand-file-name over default-files:
(expand-file-name (if default-files default-files-string-new "*")
file)
file))
(nreverse files))))

You could use advices to do that:
(defvar wd-alist nil)
(mapc
(lambda (function)
(eval
`(defadvice ,function (around ,(intern (format "%s-wd" function)) activate)
(let ((wd (cdr (assoc ',function wd-alist))))
(unless wd
(setq wd (read-file-name "Default directory: "))
(push (cons ',function wd) wd-alist))
(let ((default-directory wd))
ad-do-it)))))
'(grep-find))
The variable wd-list stores the association (FUNCTION . PATH). The list mapc iterate over are the advised functions. Now, when calling find-grep, it asks for the working directory (after interactive arguments, so you first have to type the pattern and enter...) and stores it in wd-list for further use. Now your find-grep are always done in that directory.

You could have a custom variable for the sane default, and then have the user enter the path or accept the default on the first call.
(defcustom default-path "/tmp/foo" "Path")
(setq current-path nil)
(defun foo ()
(interactive)
(unless current-path
(setq current-path
(read-from-minibuffer
(format "Path [%s]" default-path) nil nil t nil default-path)))
(message "Path is: %s" current-path))
The first time you do M-x foo, it prompts for the path. A common idiom is to allow the user to specify a prefix argument when they want to change the value (after the first time.) This code will have the desired effect:
(defun foo (choose)
(interactive "P")
(when (or choose (not current-path))
(setq current-path
(read-from-minibuffer
(format "Path [%s]" default-path) nil nil t nil default-path)))
(message "Path is: %s" current-path))
Now doing M-x foo is the same as before, but C-0 M-x foo will prompt for a new value.
In your example, something like this will work.
(defun igrep-read-files (&optional prompt-prefix)
(interactive "P")
(when (or prompt-prefix (not current-path ))
(setq current-path
(read-file-name "Dir: " default-path nil t)))
(message (expand-file-name default-files-string-new current-path)))

Have a look at the code of sendmail-query-once.
Although it's not very fashionable to do this sort of thing.
Usually package writers pick a sane default and let the user
customize it as they want.

Related

Org-mode archive entire file if all TODOs DONE

While I've seen a lot of SO questions regarding archiving sub-trees, I use org-journal to create a daily file each day with a template (eg. 2018-09-14.org) which then I then record todos in a pre-templated structure for personal, work or what have you which go through various states till they are either finished DONE or cancelled KILL (I find this approach works for me since it also allows me visually to see in the agenda view how long a task has been hanging around since started).
I am trying to write an interactive function which:
processes a list of all my .org agenda files, and
if it detects all TODOs and DONE or KILL in the file (or there are none present),
prompts me y, n, skip to move the entire file to its whatever.org_archive
(starting to see slowdowns with agenda builds 5 months into using org-mode).
I'm assuming someone else already uses a similar approach ('cause emacs) but was wondering if anyone could point me at a similar function or approach that would be helpful for sussing this out. Googling and thrashing on the elisp has been unproductive so far.
=== One month later ===
Well, teaching myself some lisp has helped but am now at the point where I have the 3 independent functions working, but for some reason am getting an error on calling the final function.
However, I'm getting an error on line 28 with invalid function: on the call to rename-file-buffer-to-org-archive. If someone can see what the problem is, this solves my use case (and probably someone else's which is why I pasted it back here.).
(defun archive-done-org-journal-files ()
"Cycles all org files through checking function."
(interactive)
(save-excursion
(mapc 'check-org-file-finito (directory-files "~/Desktop/test_archives/" t ".org$"))
))
(defun check-org-file-finito (f)
"Checks TODO keyword items are DONE then archives."
(interactive)
(find-file f)
;; Shows open Todo items whether agenda or todo
(let (
(kwd-re
(cond (org-not-done-regexp)
(
(let ((kwd
(completing-read "Keyword (or KWD1|KWD2|...): "
(mapcar #'list org-todo-keywords-1))))
(concat "\\("
(mapconcat 'identity (org-split-string kwd "|") "\\|")
"\\)\\>")))
((<= (prefix-numeric-value) (length org-todo-keywords-1))
(regexp-quote (nth (1- (prefix-numeric-value))
org-todo-keywords-1)))
(t (user-error "Invalid prefix argument: %s")))))
(if (= (org-occur (concat "^" org-outline-regexp " *" kwd-re )) 0)
((rename-file-buffer-to-org-archive)
(kill-buffer (current-buffer)))
(kill-buffer (current-buffer))
)))
(defun rename-file-buffer-to-org-archive ()
"Renames current buffer and file it's visiting."
(interactive)
(let ((name (buffer-name))
(filename (buffer-file-name))
)
(if (not (and filename (file-exists-p filename)))
(error "Buffer '%s' is not visiting a file!" name)
(let ((new-name (concat (file-name-sans-extension filename) ".org_archive")))
(if (get-buffer new-name)
(error "A buffer named '%s' already exists!" new-name)
(rename-file filename new-name 1)
(rename-buffer new-name)
(set-visited-file-name new-name)
(set-buffer-modified-p nil)
(message "File '%s' successfully archived as '%s'."
name (file-name-nondirectory new-name)))))))
So, in the end, this is how I solved it. I'm sure there are optimizations and refactoring to be done here, but this definitely works and is reasonably modular if you need to figure it out. Just change the directory you use (mine is in Dropbox) for your org-files in the archive-done-org-journal-files and this should work for you. I highly recommend testing this on a test archive as per the ~/Desktop/test_archives/ directory as per the actual function just so you can make sure it works as advertised. YMMV. Hope it helps someone!
(defun archive-done-org-journal-files ()
"Cycles all org files through checking function."
(interactive)
(save-excursion
(mapc 'check-org-file-finito (directory-files "~/Desktop/test_archives/" t ".org$"))
))
(defun check-org-file-finito (f)
"Checks TODO keyword items are DONE then archives."
(interactive)
(find-file f)
;; Shows open Todo items whether agenda or todo
(let (
(kwd-re
(cond (org-not-done-regexp)
(
(let ((kwd
(completing-read "Keyword (or KWD1|KWD2|...): "
(mapcar #'list org-todo-keywords-1))))
(concat "\\("
(mapconcat 'identity (org-split-string kwd "|") "\\|")
"\\)\\>")))
((<= (prefix-numeric-value) (length org-todo-keywords-1))
(regexp-quote (nth (1- (prefix-numeric-value))
org-todo-keywords-1)))
(t (user-error "Invalid prefix argument: %s")))))
(if (= (org-occur (concat "^" org-outline-regexp " *" kwd-re )) 0)
(rename-file-buffer-to-org-archive)
(kill-buffer (current-buffer))
)))
(defun rename-file-buffer-to-org-archive ()
"Renames current buffer and file it's visiting."
(interactive)
(let ((name (buffer-name))
(filename (buffer-file-name))
)
(if (not (and filename (file-exists-p filename)))
(error "Buffer '%s' is not visiting a file!" name)
(let ((new-name (concat (file-name-sans-extension filename) ".org_archive")))
(if (get-buffer new-name)
(error "A buffer named '%s' already exists!" new-name)
(rename-file filename new-name 1)
(rename-buffer new-name)
(set-visited-file-name new-name)
(set-buffer-modified-p nil)
(kill-buffer (current-buffer))
(message "File '%s' successfully archived as '%s'."
name (file-name-nondirectory new-name)))))))

Result value of elisp code stored in a file?

Looking for a way how evaluate elisp code stored in an external file and pass its result as a function argument. Example demonstrating what I'd like to achieve follows:
;; content of my_template.el
'(this is a list)
;; content of .emacs where result of my_template.el has to be used
(define-auto-insert "\.ext$"
;; bellow is my attempt to retrieve resulting list object
;; but getting nil instead
(with-temp-buffer
(insert-file-contents ("my_template.el"))
(eval-buffer))))
Probably looking for an eval-like function which besides side-effect also returns result of the last expression.
Any idea ?
Using variable to share data is easier and more common, for example:
;; content of ~/my_template.el
(defvar my-template '(this is a list))
;; content of .emacs where result of my_template.el has to be used
(load-file "~/my_template.el")
(define-auto-insert "\.ext$"
my-template)
Update the function eval-file should do what you want:
;; content of ~/my_template.el
'(this is a list)
(defun eval-file (file)
"Execute FILE and return the result of the last expression."
(load-file file)
(with-temp-buffer
(insert-file-contents file)
(emacs-lisp-mode)
(goto-char (point-max))
(backward-sexp)
(eval (sexp-at-point))))
(eval-file "~/my_template.el")
=> (this is a list)
Update two: without evaluate the last expression twice
(defun eval-file (file)
"Execute FILE and return the result of the last expression."
(eval
(ignore-errors
(read-from-whole-string
(with-temp-buffer
(insert-file-contents file)
(buffer-string))))))
(eval-file "~/my_template.el")
=> (this is a list)
Don't read from a string. Read from a buffer.
(defun load&return (file &optional msgp)
"Load FILE. Return the value of the last sexp read."
(interactive "fFile: \np")
(let* ((sexp (with-current-buffer (find-file-noselect file)
(goto-char (point-min))
(read (current-buffer))))
(val (ignore-errors (eval sexp))))
(prog1 val (when msgp (message "Value: %S" val)))))

How to throw a value when exiting recursive edit (without using setq)

Is it possible to throw a value when exiting recursive edit without using setq?
The functions below work correctly with setq, however, my goal is to eliminate unnecessary global variables (if possible) -- especially file names -- and use let bound variables instead. In the context of throwing a value when exiting recursive edit, however, I have been unable to devise a method that does not use a global variable for the file name.
In this example, I am using lawlist-save-as in conjunction with dired-read-file-name to enter dired-mode and select a file name or a path. Pressing the enter key on a file name selects a file. Pressing the enter key on a directory name or the two (2) dots moves up one directory. Pressing the enter key on the line with just one (1) dot, means select only the path in the current directory. The value of the file name or path is passed back to the function lawlist-save-as through the last line of dired-read-file-name.
[Although not necessary for this example (but just in case anyone is curious), getting marked files with (dired-get-marked-files) is used for a different situation, such as attaching multiple files to an e-mail using Wanderlust -- in which case, I use the condition ((listp lawlist-filename) (throw 'exit nil)). And, of course, opening a file is self-explanatory -- used for a situation when dired-mode is entered regularly and then just pressing the return key on a file to be opened.]
(require 'dired)
(defvar lawlist-filename nil)
(defvar save-as-buffer-filename nil)
(defvar save-as-variable nil)
(defvar dired-buffer-name nil)
(defun dired-read-file-name (&optional directory)
(let ((working-buffer (buffer-name)))
(if directory
(dired directory)
(dired nil))
(let ((dired-buffer-name (buffer-name)))
(if save-as-buffer-filename
(progn
(goto-char (point-min))
(re-search-forward (file-name-nondirectory save-as-buffer-filename) nil t)))
(recursive-edit)
(kill-buffer dired-buffer-name)
(switch-to-buffer working-buffer)
lawlist-filename)))
;; select file or directory.
(define-key dired-mode-map (kbd "<return>") (lambda () (interactive)
(setq lawlist-filename
(if (or (re-search-backward "^*" nil t)
(re-search-forward "^*" nil t))
(dired-get-marked-files)
(dired-get-file-for-visit)))
(cond
((listp lawlist-filename)
(throw 'exit nil))
;; open file
((and (not (file-directory-p lawlist-filename))
(file-exists-p lawlist-filename)
(not (equal lawlist-filename (concat (file-name-directory lawlist-filename) ".")))
(not save-as-variable))
(find-file lawlist-filename))
;; save-as
((and (not (file-directory-p lawlist-filename))
(file-exists-p lawlist-filename)
(not (equal lawlist-filename (concat (file-name-directory lawlist-filename) "."))))
(throw 'exit nil))
;; go up one directory
((and (file-directory-p lawlist-filename)
(not (equal lawlist-filename (concat (file-name-directory lawlist-filename) "."))))
(setq dired-buffer-name (buffer-name))
(dired-find-file)
(goto-char (point-min))
(re-search-forward " \\.\\.$" nil t)
(kill-buffer dired-buffer-name)
(setq dired-buffer-name (buffer-name)))
;; only use current path for save-as situation.
((and (equal lawlist-filename (concat (file-name-directory lawlist-filename) "."))
save-as-variable)
(setq lawlist-filename (expand-file-name default-directory))
(throw 'exit nil)) )))
(defun lawlist-save-as ()
(interactive)
(setq save-as-variable t)
(if (buffer-file-name)
(setq save-as-buffer-filename (buffer-file-name)))
(let ((proposed-filename (dired-read-file-name)))
(when proposed-filename ;; needed if aborting recursive-edit
(setq save-as-variable nil)
(let ((save-as-filename (read-string "Save-As: "
(concat proposed-filename (when (file-directory-p proposed-filename) (buffer-name))))))
(setq save-as-buffer-filename nil)
(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)))))
recursive-edit is just a function that runs a command loop. All stuff that is valid for lisp applies.
So if you encapsulate recursive-edit into a let which locally binds some variable, say test, and if you setq this variable during the recursive edit session this variable is just set locally in the scope of the let.
Example:
Run the following with C-x C-e:
(let (test)
(recursive-edit)
(message "test=%S" test))
You will be in the command loop of the recursive edit. Then set test via M-: (setq test "That is my test.").
Afterwards press M-C-c to exit the recursive edit session.
The message test=\"That is my test.\" is be printed out but the symbol test is still unbound.

Shortcut for inserting environments in `org-mode`

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)))

The mechanism iswtichb used to show completions

all.
I decided to hack iswitchb this morning, and found a confusing thing.
Usually,when we command iswitchb,we got someting in minibuffer like:
iswitch {buffer1,buffer2 ...}
What in braces is the completions, as we typing its number
is shrinking.
And I didn't find how iswitchb achieved this when hacking on
its code (sorry for my dullness ).
This is original iswitchb-read-buffer with doc-string ripped
off:
(defun iswitchb-read-buffer (prompt &optional default require-match
start matches-set)
(let
(
buf-sel
iswitchb-final-text
(icomplete-mode nil) ;; prevent icomplete starting up
)
(iswitchb-define-mode-map)
(setq iswitchb-exit nil)
(setq iswitchb-default
(if (bufferp default)
(buffer-name default)
default))
(setq iswitchb-text (or start ""))
(unless matches-set
(setq iswitchb-rescan t)
(iswitchb-make-buflist iswitchb-default)
(iswitchb-set-matches))
(let
((minibuffer-local-completion-map iswitchb-mode-map)
;; Record the minibuffer depth that we expect to find once
;; the minibuffer is set up and iswitchb-entryfn-p is called.
(iswitchb-minibuf-depth (1+ (minibuffer-depth)))
(iswitchb-require-match require-match))
;; prompt the user for the buffer name
(setq iswitchb-final-text (completing-read
prompt ;the prompt
'(("dummy" . 1)) ;table
nil ;predicate
nil ;require-match [handled elsewhere]
start ;initial-contents
'iswitchb-history)))
(if (and (not (eq iswitchb-exit 'usefirst))
(get-buffer iswitchb-final-text))
;; This happens for example if the buffer was chosen with the mouse.
(setq iswitchb-matches (list iswitchb-final-text)
iswitchb-virtual-buffers nil))
;; If no buffer matched, but a virtual buffer was selected, visit
;; that file now and act as though that buffer had been selected.
(if (and iswitchb-virtual-buffers
(not (iswitchb-existing-buffer-p)))
(let ((virt (car iswitchb-virtual-buffers))
(new-buf))
;; Keep the name of the buffer returned by find-file-noselect, as
;; the buffer 'virt' could be a symlink to a file of a different name.
(setq new-buf (buffer-name (find-file-noselect (cdr virt))))
(setq iswitchb-matches (list new-buf)
iswitchb-virtual-buffers nil)))
;; Handling the require-match must be done in a better way.
(if (and require-match
(not (iswitchb-existing-buffer-p)))
(error "Must specify valid buffer"))
(if (or (eq iswitchb-exit 'takeprompt)
(null iswitchb-matches))
(setq buf-sel iswitchb-final-text)
;; else take head of list
(setq buf-sel (car iswitchb-matches)))
;; Or possibly choose the default buffer
(if (equal iswitchb-final-text "")
(setq buf-sel (car iswitchb-matches)))
buf-sel))
And this is the part of iswitchb-read buffer,which I thought
is responsible for functioning completion mechanism.
(defun iswitchb-read-buffer (prompt &optional default require-match
start matches-set)
(let
(
(iswitchb-minibuf-depth (1+ (minibuffer-depth)))
)
;; prompt the user for the buffer name
(completing-read
prompt ;the prompt
'(("dummy" . 1)) ;table
nil ;predicate
nil ;require-match [handled elsewhere]
start ;initial-contents
'iswitchb-history)))
Eval
(iswitchb-read-buffer "Test: ")
resulting
Test: {buffer1,buffer2,...}
So, I think I'm right.
So,what confused me is how can sexp:
(iswitchb-minibuf-depth (1+ (minibuffer-depth)))
has effect on what echos in minibuffer. Comment this
sexp,or replace iswitchb-minibuffer-depth with another
variable, the completions will disappear.
Any advice?
This variable is used in iswitchb-entryfn-p which is called from iswitchb-minibuffer-setup
(defun iswitchb-minibuffer-setup ()
"Set up minibuffer for `iswitchb-buffer'.
Copied from `icomplete-minibuffer-setup-hook'."
(when (iswitchb-entryfn-p)
(set (make-local-variable 'iswitchb-use-mycompletion) t)
(add-hook 'pre-command-hook 'iswitchb-pre-command nil t)
(add-hook 'post-command-hook 'iswitchb-post-command nil t)
(run-hooks 'iswitchb-minibuffer-setup-hook)))
When iswitchb-minibuf-depth is null then iswitchb-entryfn-p is null and the setup is not done.
The iswitchb-minibuffer-setup is a hook which is added to the iswitchb-mode.
BTW, while this may not directly answer your question, this part of iswitchb's behavior is also provided by icomplete-mode (for the normal completion code).