Emacs: extending dired-do-compress to directories - emacs

If I press 'Z' in dired (or x-dired) mode in emacs, the file under the cursor is compressed or uncompressed.
I'd like to extend this behavior to directories. That is, if the cursor is at a directory "stuff", I'd like 'Z' to run
tar -zcf stuff.tgz stuff
(on the assumption that 'tar' is provided by the OS).
Side note:
The converse (expanding stuff.tgz into the full directory tree) can already be done by '!', which suggests guesses for expansion. The asymmetry ('Z' to compress and '!' to uncompress) does not bother me.

Cool idea. Here's a start that works for me: just need to change a few lines in dired-compress-file. I've highlighted the changes with BEGIN EDIT and END EDIT comments (sorry if there's a better way to highlight a diff). I'm sure this isn't robust, but maybe it can point you in the right direction.
EDIT: I should say that the below works for me in GNU Emacs 24.3.1.
(defun dired-compress-file (file)
;; Compress or uncompress FILE.
;; Return the name of the compressed or uncompressed file.
;; Return nil if no change in files.
(let ((handler (find-file-name-handler file 'dired-compress-file))
suffix newname
(suffixes dired-compress-file-suffixes))
;; See if any suffix rule matches this file name.
(while suffixes
(let (case-fold-search)
(if (string-match (car (car suffixes)) file)
(setq suffix (car suffixes) suffixes nil))
(setq suffixes (cdr suffixes))))
;; If so, compute desired new name.
(if suffix
(setq newname (concat (substring file 0 (match-beginning 0))
(nth 1 suffix))))
(cond (handler
(funcall handler 'dired-compress-file file))
((file-symlink-p file)
nil)
((and suffix (nth 2 suffix))
;; We found an uncompression rule.
(if (not (dired-check-process (concat "Uncompressing " file)
(nth 2 suffix) file))
newname))
(t
;;; We don't recognize the file as compressed, so compress it.
;;; Try gzip; if we don't have that, use compress.
(condition-case nil
;; BEGIN EDIT - choose the correct name if looking at a directory
(let ((out-name (if (file-directory-p file) (concat file ".tar.gz") (concat file ".gz"))))
;; END EDIT
(and (or (not (file-exists-p out-name))
(y-or-n-p
(format "File %s already exists. Really compress? "
out-name)))
;; BEGIN EDIT: create a tarball if we're looking at a directory
(not (if (file-directory-p file)
(dired-check-process (concat "Compressing " file)
"tar" "-zcf" out-name file)
(dired-check-process (concat "Compressing " file)
"gzip" "-f" file)))
;; END EDIT
(or (file-exists-p out-name)
(setq out-name (concat file ".z")))
;; Rename the compressed file to NEWNAME
;; if it hasn't got that name already.
(if (and newname (not (equal newname out-name)))
(progn
(rename-file out-name newname t)
newname)
out-name)))
(file-error
(if (not (dired-check-process (concat "Compressing " file)
"compress" "-f" file))
;; Don't use NEWNAME with `compress'.
(concat file ".Z"))))))))

The following is a link to the library dired-tar -- it tars and compresses directories and files. I have verified it works on OSX with a recent version of Emacs Trunk built on March 19, 2014.
http://www.emacswiki.org/emacs/DiredTar

This functionality is now installed in master:
press Z on a directory to run tar -czf dirname.tar.gz dirname
press Z on a *.tar.gz file to run tar -zxvf dirname
The latter can be customized via dired-compress-file-suffixes, if you ever need to use something other than -zxvf.

Related

Update gtag file in emacs for a single file once on saving

My configuration is copied from http://www.emacswiki.org/emacs/GnuGlobal#toc4 . The purpose is to update existing tag file once i save source file. But the result is the same as expected.
The full configuration is:
(gtags-mode 1)
(defun gtags-root-dir ()
"Returns GTAGS root directory or nil if doesn't exist."
(with-temp-buffer
(if (zerop (call-process "global" nil t nil "-pr"))
(buffer-substring (point-min) (1- (point-max)))
nil)))
(defun gtags-update-single(filename)
"Update Gtags database for changes in a single file"
(interactive)
(start-process "update-gtags" "update-gtags" "bash" "-c" (concat "cd " (gtags-root-dir) " ; gtags --single-update " filename )))
(defun gtags-update-current-file()
(interactive)
(defvar filename)
(setq filename (replace-regexp-in-string (gtags-root-dir) "." (buffer-file-name (current-buffer))))
(gtags-update-single filename)
(message "Gtags updated for %s" filename))
(defun gtags-update-hook()
"Update GTAGS file (insert )ncrementally upon saving a file"
(when gtags-mode ;;It is copy past error..
(when (gtags-root-dir)
(gtags-update-current-file))))
(add-hook 'after-save-hook 'gtags-update-hook)
Update
My understanding is that tags will be update via command
(gtags-update-single filename)
(message "Gtags updated for %s" filename))
once file in buffer is saved. That means a new added or renamed or removed function will be updated to the tag file. In my test, I do see output message(The tags is in ededemo directory ):
Wrote /other/projectbase/cplusproject/ededemo/src/main.cpp
Gtags updated for ./src/main.cpp
each time function is renamed or added after c-x c-s. But M-x gtags-find-tag could not find my new added function. Is there any wrong in understanding?
This line is clearly responsible/broken:
(when gtags-;-*- mode: ${1:mode} -*-
Looking at the Wiki page, I can't fathom how you managed to end up with that.
The docstring comment is also corrupted. Just copy the whole function again.

Going root when writing to file/saving file?

Is it possible to open a file(in root location) as non-root user in Emacs, edit it and then when its time to save provide the password so the Emacs can get write to the file? Better still provide different buffers with different user privileges?
I know of Tramp but couldn't get my head around it.
Here's how I do it:
(require 'tramp)
(defun sudired ()
(interactive)
(dired "/sudo::/"))
You'll get a dired buffer where you have root privileges.
Any subsequent directory or file that you open from here will be with root.
Any other dired buffers will not be affected.
Update: I now use sudo-edit (available on Melpa or at https://github.com/nflath/sudo-edit), which has the header warning and is more robust than this function.
This is what I use. You can open a file (even one that doesn't exist yet) or directory as a normal user, and run this function to get root privileges.
(defun find-alternative-file-with-sudo ()
(interactive)
(let ((bname (expand-file-name (or buffer-file-name
default-directory)))
(pt (point)))
(setq bname (or (file-remote-p bname 'localname)
(concat "/sudo::" bname)))
(cl-flet ((server-buffer-done
(buffer &optional for-killing)
nil))
(find-alternate-file bname))
(goto-char pt)))
I also have this, which makes a big red banner across the top of the buffer telling me it's opened as root.
(defface find-file-root-header-face
'((t (:foreground "white" :background "red3")))
"*Face use to display header-lines for files opened as root.")
(defun find-file-root-header-warning ()
"*Display a warning in header line of the current buffer.
This function is suitable to add to `find-file-hook'."
(when (string-equal
(file-remote-p (or buffer-file-name default-directory) 'user)
"root")
(let* ((warning "WARNING: EDITING FILE AS ROOT!")
(space (+ 6 (- (window-width) (length warning))))
(bracket (make-string (/ space 2) ?-))
(warning (concat bracket warning bracket)))
(setq header-line-format
(propertize warning 'face 'find-file-root-header-face)))))
(add-hook 'find-file-hook 'find-file-root-header-warning)
(add-hook 'dired-mode-hook 'find-file-root-header-warning)
You don't need any special functions for this, it's built-in to Emacs (at least it is for version 24).
To open a file as root:
C-x C-f to open the find-file dialog in the minibuffer.
Then prepend /su::/ to the file path:
/su::/path/to/root/file
You'll be prompted for the root password. After that, you can open the file as if you are root. The rest of your buffers will be unaffected. However, if you open another file from the same buffer, you'll automatically be opening it as root.
I wanted to have a way to open root files too, so I came up with this function that replaced build in find-file, now I have this in my .emacs:
(defun test (&rest args)
(with-temp-buffer
(eq (apply 'call-process "test" nil (current-buffer) nil args) 0)))
(defun have-permission (filename)
;; only bash expand ~ with home directory
(let ((expanded (replace-regexp-in-string "~"
(concat "/home/" (user-real-login-name))
filename)))
(if (not (file-exists-p expanded))
(let ((directory (file-name-directory expanded)))
(and (test "-r" directory) (test "-x" directory) (test "-w" directory)))
(and (test "-r" expanded) (test "-w" expanded)))))
(defun find-every-file (filename &optional wildcards)
"Open file use sudo:: if user have no permissions to open the file"
(interactive
(find-file-read-args "Find All Files: "
(confirm-nonexistent-file-or-buffer)))
(find-file (if (have-permission filename)
filename
;; you can replace that with /su:: if you don't have sudo access
(concat "/sudo::" (file-truename filename)))))
(global-set-key (kbd "C-x C-f") 'find-every-file)
It also work if you try to open non existing file or non existing file in directory you don't have write permissions.
you can combine it with #jpkotta warning popup.

Waiting on compilation to finish

I am using compile to pull new files from source tree using mercurial "hg pull".
I am performing a save of all buffers before the pull and would like to "refresh all opened buffers" after the compilation "pulling" finishes.
I tried experimenting with compilation-finish-functions but found out that the functions added to the list will be executed after "every" compilation. Since I use compile to search IDs "gid" I don't want to refresh opened files on every search.
How can I wait on compilation to finish before refreshing opened files "only" while inside a command and not on every compile outside of the command.
Here is the code:
; From http://www.emacswiki.org/emacs/CompileCommand
(defun compile-pkg (&optional command startdir)
"Compile a package, moving up to the parent directory
containing configure.ac, if it exists. Start in startdir if defined,
else start in the current directory."
(interactive)
(let ((dirname) (dir-buffer nil))
(setq startdir (expand-file-name (if startdir startdir ".")))
(setq command (if command command compile-command))
(setq dirname (upward-find-file "Makefile" startdir))
; (setq dirname (if dirname dirname (upward-find-file "Makefile" startdir)))
; (setq dirname (if dirname dirname (expand-file-name ".")))
; We've now worked out where to start. Now we need to worry about
; calling compile in the right directory
(save-excursion
(setq dir-buffer (find-file-noselect dirname))
(set-buffer dir-buffer)
(compile command)
(kill-buffer dir-buffer)
)))
(defun upward-find-file (filename &optional startdir)
"Move up directories until we find a certain filename. If we
manage to find it, return the containing directory. Else if we
get to the toplevel directory and still can't find it, return
nil. Start at startdir or . if startdir not given"
(let ((dirname (expand-file-name
(if startdir startdir ".")))
(found nil) ; found is set as a flag to leave loop if we find it
(top nil)) ; top is set when we get
; to / so that we only check it once
; While we've neither been at the top last time nor have we found
; the file.
(while (not (or found top))
; If we're at / set top flag.
(if (string= (expand-file-name dirname) "/")
(setq top t))
; Check for the file
(if (file-exists-p (expand-file-name filename dirname))
(setq found t)
; If not, move up a directory
(setq dirname (expand-file-name ".." dirname))))
; return statement
(if found (concat dirname "/") nil)))
(defun compile-hgpull ()
(interactive)
(save-all-buffers)
(compile-pkg "hg pull -u")
; if (compile finished) -> (revert-all-buffers)
)
(global-set-key [f1] 'compile-hgpull)
compile is async. So, you have two choices.
One, don't use compile. Instead use one of the other ways to invoke a shell command, like shell-command or start-process or call-process. I think this is probably preferred; I don't see why you'd need to use compile here.
Two, set compilation-finish-function.
If you want to run a shell-command synchronously, and then see its output, it might be easier to use shell-command-to-string than compile.

How can I specify a custom path to the annotation files in tuareg-mode emacs?

Is there anyway to specify the path to the annot files when using tuareg-mode in emacs?
I am trying to find out the type for my functions and the mode complains with
"not annotation file".
My build structure is:
lib
obj
*.o
*.cmi
*.cmx
*.annot
src
*.ml
*.mli
I don't think you can easily configure this: have a look at the caml-types-locate-type-file function in the caml-types.el file in your ocaml installation.
This is the function that searches for .annot files. You can probably edit it to replace the "_build" (which is where ocamlbuild puts the generated files) with obj and be done with that.
A much better option is to define a variable in your .emacs.el, and use it in the caml-types.el file. this way, you could even propose the patch to the ocaml people.
The following code suffices for me: it creates a new customization variable (which I haven't bound to a customization group, but you can if you want), then uses that variable as a list of directories to search.
(defcustom caml-types-annot-directories-search
'("_build" "obj" "../obj")
"List of directories to search for .annot files"
:type '(repeat string)
)
(defun or-list (f lst)
(if (null lst) nil
(if (apply f (car lst) nil)
(car lst)
(or-list f (cdr lst)))))
(add-hook 'tuareg-mode-hook
(lambda ()
(defun caml-types-locate-type-file (target-path)
(let ((sibling (concat (file-name-sans-extension target-path) ".annot")))
(if (file-exists-p sibling)
sibling
(let ((project-dir (file-name-directory sibling))
(test-dir (lambda (prefix)
(message "Prefix is %s" prefix)
(setq type-path
(expand-file-name
(file-relative-name sibling project-dir)
(expand-file-name prefix project-dir)))
(message "Testing %s" type-path)
(file-exists-p type-path)))
type-path)
(while (not (or-list test-dir caml-types-annot-directories-search))
(if (equal project-dir (caml-types-parent-dir project-dir))
(error (concat "No annotation file. "
"You should compile with option \"-annot\".")))
(setq project-dir (caml-types-parent-dir project-dir)))
type-path))))))
# soft link .annot files so that Emacs' tuareg-mode can find them
mkdir -p _build
for f in `find lib/obj -name *.annot` ; do ln -s ../$f _build/ ; done

How can I access the path to the current directory in an emacs directory variable file?

According to the Emacs documentation, Directory Variables apply to all files below a directory that contains an .dir-locals.el file.
How can I, in that file, set a variable to the full path that contains the file? For example:
((nil . ((indent-tabs-mode . t)
(my-project-path **THIS_DIRECTORY**))))
I asked myself the same question and found no solution on the web, so I think this answer may help. Actually, it turns out we can reuse dir-locals-find-file to get the directory containing the .dir-locals.el file. So here's what I found for, e.g, setting up an aspell personal dictionary dedicated to a whole directory:
((nil . ((eval . (setq ispell-personal-dictionary
(expand-file-name
".aspell_words"
(file-name-directory
(let ((d (dir-locals-find-file ".")))
(if (stringp d) d (car d))))))))))
Also, it seems entries are evaluated in the order they are specified, so the following code should work:
((nil . ((eval . (set (make-local-variable 'my-project-path)
(file-name-directory
(let ((d (dir-locals-find-file ".")))
(if (stringp d) d (car d))))))
(eval . (message "Project directory set to `%s'." my-project-path)))))
Emacs will complain about unsafe local variables (due to the eval construct), yet one can still permanently mark it safe.
Update: Since Emacs ≥ 26.3 (and maybe older versions as well), it appears that one needs to use (dir-locals-find-file "./") instead of (dir-locals-find-file ".").
I think (file-name-directory (or load-file-name buffer-file-name)) should give you the directory path.
See Link
Edit: Except it won't, because any eval expressions are evaluated in the context of the buffer whose variables are being hacked.
In my case, I wanted to locate a file that was relative to my current working directory for my repository, and the .dir-locals.el file was checked into the root, so a file "local" to the .dir-locals.el was also a file "local" to the project root.
pajato0's answer above worked for some cases, but it was also breaking other modes (like magit). I got around the issue by using the projectile package's projectile-project-root function to find my the base path for me:
((nil . ((eval . (setq cmake-ide-build-dir
(concat (projectile-project-root) "/build-make"))
))))
I've found the locate-dominating-file procedure, which comes out-of-the-box with Emacs, useful to retreive the current directory of a known file. The example below sets the guix-directory variable to the topmost directory of the project containing a .dir-locals.el file.
((nil . ((eval . (setq guix-directory
(locate-dominating-file default-directory
".dir-locals.el"))))))
It's not a safe .dir-locals.el setting, due to relying on eval, but it gets the job done.
In case it still matters, to the OP or some other, I would suggest you create a function to generate the .dir-locals.el file. Then one could write something like:
(let ((path default-directory)
file)
(setq file (format "%s/.dir-locals.el" path))
(with-temp-buffer
(insert (format "((nil . ((indent-tabs-mode . t)
(my-project-path \"%s\"))))" path))
(when (file-writable-p file)
(write-region (point-min)
(point-max)
file))))
to be executed within the project home directory.
hack-local-variables is the main function for processing all local variables, and it calls hack-dir-local-variables to deal with the .dir-locals.el file (or a dir local class variable, if you're not using that file).
The code for establishing the directory is not isolated in its own function, so we'll have to copy it out into a new function (this from GNU Emacs 24.0.95.1):
(defun my-dir-locals-dir ()
"Return the directory local variables directory.
Code taken from `hack-dir-local-variables'."
(let ((variables-file (dir-locals-find-file (or (buffer-file-name) default-directory)))
(dir-name nil))
(cond
((stringp variables-file)
(setq dir-name (file-name-directory variables-file)))
((consp variables-file)
(setq dir-name (nth 0 variables-file))))
dir-name))
If you are working on *nix, you might get the work directory by the following elisp code,
(defun get-working-directory ()
(getenv "PWD))
Btw, I have to mentioned that, (shell-command "pwd") will result in the directory where file (which is corresponding to the buffer you are currently editing).