I have my project files set in this format:
/home/user/proj/source
/home/user/proj/source/src1
/home/user/proj/source/src1
/home/user/proj/header ...etc
I have a way to find the project path when viewing any source file
"/home/user/proj"
Also, (buffer-file-name) gives the full absolute path of a given source file.
How to write a lisp function that extract the relative path of a source file?
Meaning, if I am viewing
/home/user/proj/source/src1/file.c
I would like to have the path
"source/src1/file.c"
The following function gives me the project path:
(defun upward-find-file (filename &optional startdir)
(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)))
I always have "Makefile" in the main project folder, so
(setq dirname (upward-find-file "Makefile" startdir))
Takes care of that.
Try locate-dominating-file and file-relative-name.
(let ((fname (buffer-file-name)))
(file-relative-name fname (locate-dominating-file fname "Makefile")))
N.B. locate-dominiating-file returns nil if it can't find anything.
How about this:
(defun file-name-make-relative (filename reference)
(interactive)
(let ((reduced-path-reference)
(common-pos 0)
(depth 0)
(pos 0)
(retval ""))
(while (eq (aref filename common-pos) (aref reference common-pos))
(setq common-pos (+ common-pos 1)))
(setq reduced-path-reference (substring reference (+ common-pos 1)))
(while (< pos (length (substring reference (+ common-pos 1))))
(if (eq (aref reduced-path-reference pos) (aref "/" 0))
(setq depth (+ depth 1)))
(setq pos (+ pos 1)))
(dotimes (i depth)
(setq retval (concat retval "../")))
(setq retval (concat retval (substring filename common-pos)))
retval))
It has not been tested very thoroughly, however, in my simple testcases it worked as expected. Given a file filename and a reference directory reference (must have trailing slash, I can't remember which function does this automatically, can someone comment?) this function will calculate the relative path from reference to filename.
Example:
(file-name-make-relative "/usr/local/bin/exec" "/usr/local/root/bin/")
Result:
"../../bin/exec"
Install f.el, a comprehensive file and directory manipulation library. Then run function f-relative:
(f-relative "some/path/is/long" "some/path/was/short") ; => "../../is/long"
You can tweak this code to your needs:
(defun java-package-name (file)
"Generates package name for FILE, based on path."
(let* ((f (file-name-directory file))
(rem
(car
(sort
(delq nil
(mapcar
(lambda(x)
(and (string-match (expand-file-name x) f)
(substring f (match-end 0))))
(parse-colon-path (getenv "CLASSPATH"))))
(lambda (a b) (< (length a) (length b)))))))
(cond
((null rem)
"Not on CLASSPATH.")
((= 0 (length rem))
"At root of CLASSPATH")
(t
(mapconcat
#'downcase
(delete "" (split-string rem "[\\\\/]"))
".")))))
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'm looking for some assistance please, to distinguish between a single file extension in dired-mode (e.g., *.gz) and a double file extension (e.g., *.tar.gz).
The following is an excerpt of the function that I use when selecting one or more files in dired-mode to take specific actions -- e.g., open in Emacs, start a process and open externally, or compress / decompress. I originally wrote this function (borrowing excerpts from dired-do-create-files within dired-aux.el) with only single file type extensions in mind, and would now like to expand its functionality to include potential double file type extensions.
(defun test-for-tar-gz-extension ()
(interactive)
(let* (
(fn-list (dired-get-marked-files))
(rfn-list (mapcar (function dired-make-relative) fn-list))
(dired-one-file (and (consp fn-list) (null (cdr fn-list)) (car fn-list)))
(input-filename (if dired-one-file dired-one-file fn-list))
(ext
(cond
((stringp input-filename)
(file-name-extension input-filename))
((listp input-filename)
(file-name-extension (car input-filename)))))
(path (if (stringp input-filename) (file-name-directory input-filename)))
(dired-buffer-name (buffer-name))
(msword-regexp '("doc" "docx"))
(dired-tar '("tar.gz")))
(cond
;; http://www.emacswiki.org/emacs/DiredTar
((extension equals ".tar.gz")
(dired-tar-pack-unpack))
((extension equals ".gz" (but not .tar.gz))
(dired-do-compress))
((regexp-match-p msword-regexp ext)
(start-process "ms-word" nil "open" "-a" "Microsoft Word" input-filename))
(t
(message "Go fish.")))))
;; https://github.com/kentaro/auto-save-buffers-enhanced
;; `regexp-match-p` function modified by #sds on stackoverflow
;; http://stackoverflow.com/a/20343715/2112489
(defun regexp-match-p (regexps string)
(and string
(catch 'matched
(let ((inhibit-changing-match-data t)) ; small optimization
(dolist (regexp regexps)
(when (string-match regexp string)
(throw 'matched t)))))))
Not sure IIUC, here a draft how to do that part in question:
(defun gz-only ()
"List marked files in dired-buffer ending at `.gz', but not ending at `.tar.gz'"
(interactive)
(let ((flist (dired-get-marked-files))
erg)
(dolist (ele flist)
(and (string-match "\.gz$" ele)(not (string-match "\.tar\.gz$" ele))
(add-to-list 'erg ele)))
(when (interactive-p) (message "%s" erg))))
I'm looking for an emacs command that will toggle the surrounding quote characters on the string under the point, e.g. with the cursor in the string 'bar', hit a key and change it between:
foo = 'bar' <---> foo = "bar"
For bonus points it would:
handle toggling Python triple-quote strings (''' <---> """)
automatically change backslash escaping inside the string as appropriate.
e.g.
foo = 'bar "quote"' <---> foo = "bar \"quote\""
This could be a bit more robust:
(defun toggle-quotes ()
(interactive)
(save-excursion
(let ((start (nth 8 (syntax-ppss)))
(quote-length 0) sub kind replacement)
(goto-char start)
(setq sub (buffer-substring start (progn (forward-sexp) (point)))
kind (aref sub 0))
(while (char-equal kind (aref sub 0))
(setq sub (substring sub 1)
quote-length (1+ quote-length)))
(setq sub (substring sub 0 (- (length sub) quote-length)))
(goto-char start)
(delete-region start (+ start (* 2 quote-length) (length sub)))
(setq kind (if (char-equal kind ?\") ?\' ?\"))
(loop for i from 0
for c across sub
for slash = (char-equal c ?\\)
then (if (and (not slash) (char-equal c ?\\)) t nil) do
(unless slash
(when (member c '(?\" ?\'))
(aset sub i
(if (char-equal kind ?\") ?\' ?\")))))
(setq replacement (make-string quote-length kind))
(insert replacement sub replacement))))
It will use syntax information from the buffer to find the quotes at the beginning of the string (that is given that the strings are quoted), and will also try to flip quotes inside the string, unless they are escaped with backslash - which looks like it could be a common case.
PS. I've just realized you also wanted it to find triple quotes, so her goes.
Here's a quick hack to get you started:
(defun toggle-quotes ()
"Toggle single quoted string to double or vice versa, and
flip the internal quotes as well. Best to run on the first
character of the string."
(interactive)
(save-excursion
(re-search-backward "[\"']")
(let* ((start (point))
(old-c (char-after start))
new-c)
(setq new-c
(case old-c
(?\" "'")
(?\' "\"")))
(setq old-c (char-to-string old-c))
(delete-char 1)
(insert new-c)
(re-search-forward old-c)
(backward-char 1)
(let ((end (point)))
(delete-char 1)
(insert new-c)
(replace-string new-c old-c nil (1+ start) end)))))
The function swaps the internal quotes to the opposite, which is close to bonus 2.
Here's something even more robust, in that it doesn't delete the whole text between the quotes (doing so prevents save-excursion from keeping the point where it was, which is a pain). Also handles (un)backslash-ing nested quotes.
(defun toggle-quotes ()
(interactive)
(let* ((beg (nth 8 (syntax-ppss)))
(orig-quote (char-after beg))
(new-quote (case orig-quote
(?\' ?\")
(?\" ?\'))))
(save-restriction
(widen)
(save-excursion
(catch 'done
(unless new-quote
(message "Not inside a string")
(throw 'done nil))
(goto-char beg)
(delete-char 1)
(insert-char new-quote)
(while t
(cond ((eobp)
(throw 'done nil))
((= (char-after) orig-quote)
(delete-char 1)
(insert-char new-quote)
(throw 'done nil))
((= (char-after) ?\\)
(forward-char 1)
(when (= (char-after) orig-quote)
(delete-char -1))
(forward-char 1))
((= (char-after) new-quote)
(insert-char ?\\)
(forward-char 1))
(t (forward-char 1)))))))))
Here's a function I made for JavaScript, might help?
function swap_str(e, r, t) {
return e = e.split(r).join("WHAK_a_SWAP"), e = e.split(t).join("WHAK_b_SWAP"), e = e.split("WHAK_a_SWAP").join(t),
e = e.split("WHAK_b_SWAP").join(r);
}
//test 1
var str = 'this is "test" of a \'test\' of swapping strings';
var manipulated = swap_str(str,"'",'"');
document.writeln(manipulated)
//test 2
manipulated = swap_str(manipulated,"'",'"');
document.writeln('<hr>'+manipulated)
The code is below but seems to have an error because it says when started can't find the remove duplicates function. Anyone have an idea how to fix this?? There is a second code on the same page with the problem. Essentially I can get it working but I want it to remove the directory names. I don't care as much about if there are duplicates. This code was posted on this page:
http://www.emacswiki.org/emacs/RecentFiles
(defun recentf-interactive-complete ()
"find a file in the recently open file using ido for completion"
(interactive)
(let* ((all-files recentf-list)
(file-assoc-list (mapcar (lambda (x) (cons (file-name-nondirectory x) x)) all-files))
(filename-list (remove-duplicates (mapcar 'car file-assoc-list) :test 'string=))
(ido-make-buffer-list-hook
(lambda ()
(setq ido-temp-list filename-list)))
(filename (ido-read-buffer "Find Recent File: "))
(result-list (delq nil (mapcar (lambda (x) (if (string= (car x) filename) (cdr x))) file-assoc-list)))
(result-length (length result-list)))
(find-file
(cond
((= result-length 0) filename)
((= result-length 1) (car result-list))
( t
(let ( (ido-make-buffer-list-hook
(lambda ()
(setq ido-temp-list result-list))))
(ido-read-buffer (format "%d matches:" result-length))))
The "remove-duplicates" function is located in the cl-seq.el file and is included in all recent versions of Emacs. It is loaded as part of the "cl" package so you just need the following line in your Emacs init file:
(require 'cl)
I need to spell check a large document containing many camelcased words. I want ispell or aspell to check if the individual words are spelled correctly.
So, in case of this word:
ScientificProgrezGoesBoink
I would love to have it suggest this instead:
ScientificProgressGoesBoink
Is there any way to do this? (And I mean, while running it on an Emacs buffer.) Note that I don't necessarily want it to suggest the complete alternative. However, if it understands that Progrez is not recognized, I would love to be able to replace that part at least, or add that word to my private dictionary, rather than including every camel-cased word into the dictionary.
I took #phils suggestions and dug around a little deeper. It turns out that if you get camelCase-mode and reconfigure some of ispell like this:
(defun ispell-get-word (following)
(when following
(camelCase-forward-word 1))
(let* ((start (progn (camelCase-backward-word 1)
(point)))
(end (progn (camelCase-forward-word 1)
(point))))
(list (buffer-substring-no-properties start end)
start end)))
then, in that case, individual camel cased words suchAsThisOne will actually be spell-checked correctly. (Unless you're at the beginning of a document -- I just found out.)
So this clearly isn't the fullblown solution, but at least it's something.
There is "--run-together" option in aspell. Hunspell can't check camelcased word.
If you read the code of aspell, you will find its algorithm actually does not split camelcase word into a list of sub-words. Maybe this algorithm is faster, but it will wrongly report word containing two character sub-word as typo. Don't waste time to tweak other aspell options. I tried and they didn't work.
So we got two problems:
aspell reports SOME camelcased words as typos
hunspell reports ALL camelcased words as typos
Solution to solve BOTH problems is to write our own predicate in Emacs Lisp.
Here is a sample predicate written for javascript:
(defun split-camel-case (word)
"Split camel case WORD into a list of strings.
Ported from 'https://github.com/fatih/camelcase/blob/master/camelcase.go'."
(let* ((case-fold-search nil)
(len (length word))
;; ten sub-words is enough
(runes [nil nil nil nil nil nil nil nil nil nil])
(runes-length 0)
(i 0)
ch
(last-class 0)
(class 0)
rlt)
;; split into fields based on class of character
(while (< i len)
(setq ch (elt word i))
(cond
;; lower case
((and (>= ch ?a) (<= ch ?z))
(setq class 1))
;; upper case
((and (>= ch ?A) (<= ch ?Z))
(setq class 2))
((and (>= ch ?0) (<= ch ?9))
(setq class 3))
(t
(setq class 4)))
(cond
((= class last-class)
(aset runes
(1- runes-length)
(concat (aref runes (1- runes-length)) (char-to-string ch))))
(t
(aset runes runes-length (char-to-string ch))
(setq runes-length (1+ runes-length))))
(setq last-class class)
;; end of while
(setq i (1+ i)))
;; handle upper case -> lower case sequences, e.g.
;; "PDFL", "oader" -> "PDF", "Loader"
(setq i 0)
(while (< i (1- runes-length))
(let* ((ch-first (aref (aref runes i) 0))
(ch-second (aref (aref runes (1+ i)) 0)))
(when (and (and (>= ch-first ?A) (<= ch-first ?Z))
(and (>= ch-second ?a) (<= ch-second ?z)))
(aset runes (1+ i) (concat (substring (aref runes i) -1) (aref runes (1+ i))))
(aset runes i (substring (aref runes i) 0 -1))))
(setq i (1+ i)))
;; construct final result
(setq i 0)
(while (< i runes-length)
(when (> (length (aref runes i)) 0)
(setq rlt (add-to-list 'rlt (aref runes i) t)))
(setq i (1+ i)))
rlt))
(defun flyspell-detect-ispell-args (&optional run-together)
"If RUN-TOGETHER is true, spell check the CamelCase words.
Please note RUN-TOGETHER will make aspell less capable. So it should only be used in prog-mode-hook."
;; force the English dictionary, support Camel Case spelling check (tested with aspell 0.6)
(let* ((args (list "--sug-mode=ultra" "--lang=en_US"))args)
(if run-together
(setq args (append args '("--run-together" "--run-together-limit=16"))))
args))
;; {{ for aspell only, hunspell does not need setup `ispell-extra-args'
(setq ispell-program-name "aspell")
(setq-default ispell-extra-args (flyspell-detect-ispell-args t))
;; }}
;; ;; {{ hunspell setup, please note we use dictionary "en_US" here
;; (setq ispell-program-name "hunspell")
;; (setq ispell-local-dictionary "en_US")
;; (setq ispell-local-dictionary-alist
;; '(("en_US" "[[:alpha:]]" "[^[:alpha:]]" "[']" nil ("-d" "en_US") nil utf-8)))
;; ;; }}
(defvar extra-flyspell-predicate '(lambda (word) t)
"A callback to check WORD. Return t if WORD is typo.")
(defun my-flyspell-predicate (word)
"Use aspell to check WORD. If it's typo return t."
(let* ((cmd (cond
;; aspell: `echo "helle world" | aspell pipe`
((string-match-p "aspell$" ispell-program-name)
(format "echo \"%s\" | %s pipe"
word
ispell-program-name))
;; hunspell: `echo "helle world" | hunspell -a -d en_US`
(t
(format "echo \"%s\" | %s -a -d en_US"
word
ispell-program-name))))
(cmd-output (shell-command-to-string cmd))
rlt)
;; (message "word=%s cmd=%s" word cmd)
;; (message "cmd-output=%s" cmd-output)
(cond
((string-match-p "^&" cmd-output)
;; it's a typo because at least one sub-word is typo
(setq rlt t))
(t
;; not a typo
(setq rlt nil)))
rlt))
(defun js-flyspell-verify ()
(let* ((case-fold-search nil)
(font-matched (memq (get-text-property (- (point) 1) 'face)
'(js2-function-call
js2-function-param
js2-object-property
js2-object-property-access
font-lock-variable-name-face
font-lock-string-face
font-lock-function-name-face
font-lock-builtin-face
rjsx-text
rjsx-tag
rjsx-attr)))
subwords
word
(rlt t))
(cond
((not font-matched)
(setq rlt nil))
;; ignore two character word
((< (length (setq word (thing-at-point 'word))) 2)
(setq rlt nil))
;; handle camel case word
((and (setq subwords (split-camel-case word)) (> (length subwords) 1))
(let* ((s (mapconcat (lambda (w)
(cond
;; sub-word wholse length is less than three
((< (length w) 3)
"")
;; special characters
((not (string-match-p "^[a-zA-Z]*$" w))
"")
(t
w))) subwords " ")))
(setq rlt (my-flyspell-predicate s))))
(t
(setq rlt (funcall extra-flyspell-predicate word))))
rlt))
(put 'js2-mode 'flyspell-mode-predicate 'js-flyspell-verify)
Or just use my new pacakge https://github.com/redguardtoo/wucuo
You should parse the camel cased words and split them, then check the individual spelling for each one and assemble a suggestion taking into account the single suggestion for each misspelled token. Considering that each misspelled token can have multiple suggestions this sounds a bit inefficient to me.