Somewhere between emacs 23.1 and 24.1, the interface of url-retrieve changed. In emacs 23.1, it looks like this:
(url-retrieve URL CALLBACK &optional CBARGS)
In version 24.1, it looks like this:
(url-retrieve URL CALLBACK &optional CBARGS SILENT INHIBIT-COOKIES)
I have an emacs package that uses this function. I'd like to take advantage of the new SILENT argument on emacs 24.1, while maintaining backwards compatibility with older versions of emacs that don't support it.
What's the best way to manage this? Can I grab the maximum number of arguments at runtime?
You can use this function to get the argument list:
(defun my-get-arglist (obj)
;; code taken from disassemble-internal
(let ((macro 'nil)
(name 'nil)
(doc 'nil)
args)
(while (symbolp obj)
(setq name obj
obj (symbol-function obj)))
(if (subrp obj)
(error "Can't disassemble #<subr %s>" name))
(if (and (listp obj) (eq (car obj) 'autoload))
(progn
(load (nth 1 obj))
(setq obj (symbol-function name))))
(if (eq (car-safe obj) 'macro) ;handle macros
(setq macro t
obj (cdr obj)))
(if (and (listp obj) (eq (car obj) 'byte-code))
(setq obj (list 'lambda nil obj)))
(if (and (listp obj) (not (eq (car obj) 'lambda)))
(error "not a function"))
(if (consp obj)
(if (assq 'byte-code obj)
nil
(setq obj (byte-compile obj))))
(cond ((consp obj)
(setq obj (cdr obj)) ;throw lambda away
(setq args (car obj)) ;save arg list
(setq obj (cdr obj)))
((byte-code-function-p obj)
(setq args (aref obj 0)))
(t (error "Compilation failed")))
args))
You could check emacs-major-version and make sure it's >= 24.
(defun try-call-with-more-args (function a b c d)
(condition-case var
(progn
(funcall function a b c d)
(message "there was no error"))
(wrong-number-of-arguments (funcall function a b c))))
(try-call-with-more-args #'message "b = %d, c = %d" 1 2 3)
Even though the one posted by Trey Jackson is much smarter, this is simpler and, actually has a good chance of working, even if you are targeting a native C function :)
If it's the older emacs version, write a wrapper around the older function:
(let ((orig-fun #'symbol-name-of-orig-fun))
(defun symbol-name-of-orig-fun (arglist of new function interface)
(declare (ignore new function interface))
(funcall orig-fun arglist of)))
This generates a lexical closure that stores the reference of the old function within the new function. I don't know the emacs dialect, but I would bet this pattern could be used in emacs. I use it every once in a while in common lisp.
Related
In js2-mode, M-. runs the command js2-jump-to-definition, this works great. But I want it go to the definition in other window. I find the code js2-jump-to-definition in Github.
What is the easiest way to make it open in other window?
(defun js2-jump-to-definition (&optional arg)
"Jump to the definition of an object's property, variable or function."
(interactive "P")
(if (eval-when-compile (fboundp 'xref-push-marker-stack))
(xref-push-marker-stack)
(ring-insert find-tag-marker-ring (point-marker)))
(js2-reparse)
(let* ((node (js2-node-at-point))
(parent (js2-node-parent node))
(names (if (js2-prop-get-node-p parent)
(reverse (let ((temp (js2-compute-nested-prop-get parent)))
(cl-loop for n in temp
with result = '()
do (push n result)
until (equal node n)
finally return result)))))
node-init)
(unless (and (js2-name-node-p node)
(not (js2-var-init-node-p parent))
(not (js2-function-node-p parent)))
(error "Node is not a supported jump node"))
(push (or (and names (pop names))
(unless (and (js2-object-prop-node-p parent)
(eq node (js2-object-prop-node-left parent)))
node)) names)
(setq node-init (js2-search-scope node names))
;; todo: display list of results in buffer
;; todo: group found references by buffer
(unless node-init
(switch-to-buffer
(catch 'found
(unless arg
(mapc (lambda (b)
(with-current-buffer b
(when (derived-mode-p 'js2-mode)
(setq node-init (js2-search-scope js2-mode-ast names))
(if node-init
(throw 'found b)))))
(buffer-list)))
nil)))
(setq node-init (if (listp node-init) (car node-init) node-init))
(unless node-init
(pop-tag-mark)
(error "No jump location found"))
(goto-char (js2-node-abs-pos node-init))))
In Python, I am able to use yield to build up a list without having to define a temporary variable:
def get_chars_skipping_bar(word):
while word:
# Imperative logic which can't be
# replaced with a for loop.
if word[:3] == 'bar':
word = word[3:]
else:
yield foo[0]
foo = foo[1:]
In elisp, I can't see any way of doing this, either built-in or using any pre-existing libraries. I'm forced to manually build a up a list and call nreverse on it. Since this is a common pattern, I've written my own macro:
(require 'dash)
(require 'cl)
(defun replace-calls (form x func)
"Replace all calls to X (a symbol) in FORM,
calling FUNC to generate the replacement."
(--map
(cond
((consp it)
(if (eq (car it) x)
(funcall func it)
(replace-calls it x func)))
(:else it))
form))
(defmacro with-results (&rest body)
"Execute BODY, which may contain forms (yield foo).
Return a list built up from all the values passed to yield."
(let ((results (gensym "results")))
`(let ((,results (list)))
,#(replace-calls body 'yield
(lambda (form) `(push ,(second form) ,results)))
(nreverse ,results))))
Example usage:
(setq foo "barbazbarbarbiz")
(with-results
(while (not (s-equals? "" foo))
;; Imperative logic which can't be replaced with cl-loop's across.
(if (s-starts-with? "bar" foo)
(setq foo (substring foo 3))
(progn
(yield (substring foo 0 1))
(setq foo (substring foo 1))))))
There must be a better way of doing this, or an existing solution, somewhere in elisp, cl.el, or a library.
The Python function is actually a generator. In ANSI Common Lisp, we would usually reach for a lexical closure to simulate a generator, or else us a library to define generators directly, like Pygen. Maybe these approaches can be ported to Emacs Lisp.
AFAIK, people just use push+nreverse like you do. If you want to define your macro in a more robust way (e.g. so it doesn't misfire on something like (memq sym '(yield stop next))) you could do it as:
(defmacro with-results (&rest body)
"Execute BODY, which may contain forms (yield EXP).
Return a list built up from all the values passed to `yield'."
(let ((results (gensym "results")))
`(let ((,results '()))
(cl-macrolet ((yield (exp) `(push ,exp ,results)))
,#body)
(nreverse ,results))))
Maybe something like this:
(setq foo "barbaz")
(cl-loop for i from 0 to (1- (length foo))
collect (string (aref foo i)))
In any case, there's nothing wrong with push and nreverse.
Lisp is different from Python. yield is not used. I also see the use of coroutine-like constructs for this as a mistake. It's the equivalent of the come-from construct. Suddenly routines have multiple context dependent entry points.
In Lisp use functions/closures instead.
In Common Lisp, the LOOP macro allows efficient mappings over vectors. The following code can be abstracted to some mapping function, if preferred:
CL-USER 17 > (defun chars-without-substring (string substring)
(loop with i = 0
while (< i (length string))
when (and (>= (- (length string) i) (length substring))
(string= substring string
:start2 i
:end2 (+ i (length substring))))
do (incf i (length substring))
else
collect (prog1 (char string i) (incf i))))
CHARS-WITHOUT-SUBSTRING
CL-USER 18 > (chars-without-substring "barbazbarbarbiz" "bar")
(#\b #\a #\z #\b #\i #\z)
From reading a Lisp book I remember they showed an example of an OOP-style method dispatcher based on closures:
(defun create-object ()
(let ((val 0)
(get (lambda () val))
(set (lambda (new-val) (setq val new-val)))
(inc (lambda () (setq val (+ 1 val)))))
(lambda (method)
(cond ((eq method 'get)
get)
((eq method 'set)
set)
((eq method 'inc)
inc)))))
(let ((obj (create-object)))
(funcall (obj 'set) 1)
(funcall (obj 'inc))
(funcall (obj 'get))) ;; 2
Since it's just a function with a string symbol argument, I guess code intel won't be of much help here, not completing the method names or their signatures. (Compare with a similar JavaScript object.)
Is this problem generally solved? How do you program an object system in Scheme so that an editor (like Emacs) can be more intelligent with your code?
P.S. The example may be not a valid Scheme code, but you should get the idea.
I've made some starting code for you.
It's for Emacs Lisp, but it's should be very easily portable to Scheme.
Here's your usage example:
(defun create-object ()
(lexical-let* ((val 0)
(get (lambda() val))
(set (lambda(x) (setq val x))))
(generate-dispatch-table get set)))
(setq obj (create-object))
(funcall (funcall obj 'get))
;; => 0
(funcall (funcall obj 'set) 1)
;; => 1
(funcall (funcall obj 'get))
;; => 1
(scheme-completions obj)
;; => (get set)
And here's how it's implemented:
(defmacro generate-dispatch-table (&rest members)
`(lambda (method)
(cond ,#(mapcar
(lambda (x) `((eq method ',x) ,x)) members))))
(defun collect (pred x)
(when (and x (listp x))
(let ((y (funcall pred x))
(z (append
(collect pred (car x))
(collect pred (cdr x)))))
(if y
(append (list y) z)
z))))
(defun scheme-completions (obj)
(collect
(lambda(x) (and (eq (car x) 'eq)
(eq (cadr x) 'method)
(eq (caaddr x) 'quote)
(cadr (caddr x))))
obj))
And here's a simple visual interface for completions:
(require 'helm)
(defun scheme-completions-helm ()
(interactive)
(let ((y (and
(looking-back "(funcall \\([^ ]*\\) +")
(intern-soft (match-string 1)))))
(when y
(helm :sources
`((name . "members")
(candidates . ,(scheme-completions (eval y)))
(action . (lambda(x) (insert "'" x))))))))
I'm not a Emacs user, but use DrRacket and it does have an object system and do what an IDE should do, but I know Emacs is very customizable since it uses elisp so you can make support for your own syntax both in syntax highlighting and tab-completion. So you do:
Make your own object system
Edit your Emacs editor to do what you want
Many of my colleagues use it and they fix their Emacs in such ways.
Another thing, this question makes me think about the resources at schemewiki.org on the subject where the different approaches are mentioned and even a similar code to the one you posted is posted as example. It's a good read.
I would avoid double notion of symbols in create-object via an obarray.
Furthermore, the interface of the object are all functions. Therefore, use fset and avoid the double funcall.
(defun create-object ()
(lexical-let (val
(_oa (make-vector 11 0)))
(fset (intern "get" _oa) (lambda () val))
(fset (intern "inc" _oa) (lambda () (incf val)))
(fset (intern "set" _oa) (lambda (new-val) (setq val new-val)))
(lambda (method &rest args)
(apply 'funcall (intern (symbol-name method) _oa) args))))
(fset 'obj1 (create-object))
(fset 'obj2 (create-object))
(obj1 'set 1)
(obj2 'set 2)
(obj1 'inc)
(obj2 'inc)
(obj2 'inc)
(obj2 'get)
(obj1 'get)
Example for inheritance:
(defun create-object ()
(lexical-let (val
(_oa (make-vector 11 0)))
(fset (intern "get" _oa) (lambda () val))
(fset (intern "inc" _oa) (lambda () (incf val)))
(fset (intern "set" _oa) (lambda (new-val) (setq val new-val)))
(lambda (method &rest args)
(apply 'funcall (or (intern-soft (symbol-name method) _oa)
(error "Undefined function: %s" method))
args))))
(defun create-object-add10 ()
(lexical-let ((base (create-object))
(_oa (make-vector 11 0)))
(fset (intern "inc" _oa) (lambda () (funcall base 'set (+ (funcall base 'get) 10))))
(lambda (method &rest args)
(let ((call (intern-soft (symbol-name method) _oa)))
(if call
(apply 'funcall call args)
(apply 'funcall base method args))))))
(fset 'obj1 (create-object))
(fset 'obj2 (create-object-add10))
(obj1 'set 1)
(obj2 'set 2)
(obj1 'inc)
(obj2 'inc)
(obj2 'inc)
(obj2 'get)
(obj1 'get)
The definition of create-object-like methods should additionally be supported through macros. That is not done here.
For more features, note, there is a CLOS-compatible object oriented system in emacs:
https://www.gnu.org/software/emacs/manual/html_node/eieio/index.html
I'm trying to temporarily turn off the yes-or-no-p within a function that is defined elsewhere and then restore things to the way they were. Using flet works, but creates a *compile-log* buffer telling me that it is obsolete and to use cl-flet instead. However, cl-flet doesn't seem to work with this attempt at defadvice -- i.e., nothing happens and the yes-or-no-p remains active. Any ideas on how to avoid the error message and make this work also?
(defun function-without-confirmation ()
(defadvice elmo-dop-queue-flush (around stfu activate)
(flet ((yes-or-no-p (&rest args) t)
(y-or-n-p (&rest args) t))
ad-do-it))
. . . .
(ad-unadvise 'elmo-dop-queue-flush)
)
I cannot take credit for the answer, because that was solved by wvxvw, so I'll put the relevant fix underneath the original question. The new macro is called lawlist-flet instad of flet, and the obsolete line has been commented out:
(defmacro lawlist-flet (bindings &rest body)
"Make temporary overriding function definitions.
This is an analogue of a dynamically scoped `let' that operates on the function
cell of FUNCs rather than their value cell.
If you want the Common-Lisp style of `flet', you should use `cl-flet'.
The FORMs are evaluated with the specified function definitions in place,
then the definitions are undone (the FUNCs go back to their previous
definitions, or lack thereof).
\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
(declare (indent 1) (debug cl-flet)
;; (obsolete "use either `cl-flet' or `cl-letf'." "24.3")
)
`(letf ,(mapcar
(lambda (x)
(if (or (and (fboundp (car x))
(eq (car-safe (symbol-function (car x))) 'macro))
(cdr (assq (car x) macroexpand-all-environment)))
(error "Use `labels', not `flet', to rebind macro names"))
(let ((func `(cl-function
(lambda ,(cadr x)
(cl-block ,(car x) ,#(cddr x))))))
(when (cl--compiling-file)
;; Bug#411. It would be nice to fix this.
(and (get (car x) 'byte-compile)
(error "Byte-compiling a redefinition of `%s' \
will not work - use `labels' instead" (symbol-name (car x))))
;; FIXME This affects the rest of the file, when it
;; should be restricted to the flet body.
(and (boundp 'byte-compile-function-environment)
(push (cons (car x) (eval func))
byte-compile-function-environment)))
(list `(symbol-function ',(car x)) func)))
bindings)
,#body))
And, here is the modified function that eliminates the error message relating to flet being obsolete.
(defun function-without-confirmation ()
(defadvice elmo-dop-queue-flush (around stfu activate)
(lawlist-flet ((yes-or-no-p (&rest args) t)
(y-or-n-p (&rest args) t))
ad-do-it))
. . . .
(ad-unadvise 'elmo-dop-queue-flush)
Here's how I'd recommend you do it:
(defvar stfu-inhibit-yonp nil)
(defadvice yes-or-no-p (around stfu activate)
(if stfu-inhibit-yonp (setq ad-return t) ad-do-it))
(defadvice y-or-n-p (around stfu activate)
(if stfu-inhibit-yonp (setq ad-return t) ad-do-it))
(defadvice elmo-dop-queue-flush (around stfu activate)
(let ((stfu-inhibit-yonp t))
ad-do-it))
Contrary to CL's flet this will make it clear (e.g. in C-h f yes-or-no-p) that something's going on with yes-or-no-p.
(defun foo ()
(send-to-debug-log "Error. Function terminated." (get-current-function-name)))
I currently do this:
(defun foo ()
(send-to-debug-log "Error. Function terminated." 'foo)))
Hard coding the function name seems not to be a good practice.
Any suggestion to implement the get-current-function-name or get-function-name-that-call-me.
(defun foo ()
(send-to-debug-log "Error. Function terminated." (nth 1 (backtrace-frame 2))))
You could try something like:
(defconst my-defun-macros '(defun cl-defun defmacro cl-defmacro))
(defun my-add-defun-name (orig-fun name &rest args)
(let* ((my-current-defun-name (if (consp name) (cadr name) name))
(macroexpand-all-environment
(cons (cons 'my-get-current-function-name
(lambda () my-current-defun-name))
macroexpand-all-environment))
(code (apply orig-fun name args)))
(macroexpand-all code macroexpand-all-environment)))
(defmacro my-get-current-function-name ()
"Return current defun's name.
Only works within the advised macros in `my-defun-macros'."
(error "my-get-current-function-name used outside of a defun"))
(dolist (m my-defun-macros)
(advice-add m :around #'my-add-defun-name))
Here's something that seems to work pretty well:
(defun calling-function ()
(let ((n 6) ;; nestings in this function + 1 to get out of it
func
bt)
(while (and (setq bt (backtrace-frame n))
(not func))
(setq n (1+ n)
func (and bt
(nth 0 bt)
(nth 1 bt))))
func))
If you call it in a lambda, you get the whole lambda. It works with apply, funcall, and eval.
I think the most simple, robust way is to just explicitly write the function name, as you're doing now.
With the package which-function-mode (in melpa), you can programmatically call the function
(Which-function)
more info:
https://www.masteringemacs.org/article/which-function-mode
http://emacsredux.com/blog/2014/04/05/which-function-mode/