The URI structure of my website changed drastically recently and I need to redirect all of the old pages to their corresponding new pages. I have a dotted list of pairs of all of the old and new URIs. At the moment I am trying to define easy handlers for each in a loop:
(let ((redirects '(("/old/uri/example-1" . "/new/uri/example-1"))))
(dolist (redirect redirects)
(hunchentoot:define-easy-handler (???? :uri (first redirect)) ()
(redirect (rest redirect)))
))
Maybe there is a better way. Assuming define-easy-handler is correct, it requires a function symbol for each easy handler. I tried the following to no avail:
Placing a (gensym) where it expects a function symbol
Using lists rather than dotted lists and calling (first redirect) where it expects a symbol
Placing a quasiquote around the whole thing and an unquote around (first redirect)
What would be a good way to accomplish this?
Let's guess: DEFINE-EASY-HANDLER is a macro.
Three typical ways to solve that:
call the underlying layer instead and don't use the macro - if the underlying layer is available for the programmer
write and use a macro which
expands (defredirects (a . a1) (b . b1) (c . c1))) into
(progn
(hunchentoot:define-easy-handler (f-a ... a) () (... a1))
(hunchentoot:define-easy-handler (f-b ... b) () (... b1))
(hunchentoot:define-easy-handler (f-c ... c) () (... c1)))
Generate the form you want to call and use eval (or compile and funcall if possible) in the loop for each form.
Although you already solved the problem I figured I might add this as an alternative. If you don't want to make a whole custom acceptor, you can add an around-method on HUNCHENTOOT:ACCEPTOR-DISPATCH-REQUEST for HUNCHENTOOT:EASY-HANDLER.
Let's make an acceptor and one page first:
(defparameter *acceptor* (make-instance 'hunchentoot:easy-acceptor :port 4242))
(hunchentoot:define-easy-handler (foo :uri "/foo") ()
(format nil "<html><body><h1>Test</h1><p>foo</p></body></html>"))
(hunchentoot:start *acceptor*)
Then redirect /bar and /quux to /foo:
;; A simple helper to create prefix dispatchers.
(defun make-redirect-list (redirects)
(mapcar (lambda (redirect)
(destructuring-bind (from . to) redirect
(hunchentoot:create-prefix-dispatcher from
(lambda ()
(hunchentoot:redirect to)))))
redirects))
(defparameter *redirects* (make-redirect-list
'(("/bar" . "/foo")
("/quux" . "/foo"))))
(defmethod hunchentoot:acceptor-dispatch-request :around
((acceptor hunchentoot:easy-acceptor) request)
(dolist (redirect *redirects*)
;; Match the request against the prefix dispatchers in *REDIRECTS*...
(let ((handler (funcall redirect request)))
(when handler
;; and call the corresponding handler if a match is found.
(return-from hunchentoot:acceptor-dispatch-request
(funcall handler)))))
;; Unless a handler was found, call next method to
;; handle the request normally.
(call-next-method))
Edit: Use around method instead of before. I initially figured that letting it call the main method normally would be necessary for any logging/etc. happening there, but after further testing it doesn't seem to be.
This solution works. I definitely appreciate feedback regarding whether or not it's best practice.
(defun add-redirect (name from to)
(eval `(hunchentoot:define-easy-handler (,name :uri ,from) ()
(redirect ,to))))
(defun add-redirects (redirects)
(dolist (redirect redirects)
(add-redirect (first redirect) (second redirect) (third redirect))
))
(add-redirects
'(
(redirect-1 "/redirect-1/" "/destination-1/")
(redirect-2 "/redirect-2/" "/destination-2/")
(redirect-3 "/redirect-3/" "/destination-3/")
))
Related
I want to create an interpreted function definition, not a compiled one.
SBCL manual says :
Variable: *evaluator-mode* [sb-ext] : Toggle between different evaluator
implementations. If set to :compile, an implementation of eval that
calls the compiler will be used. If set to :interpret, an interpreter
will be used.
So, I try to create a BAR function (which does not exist) :
(let ((sb-ext::*evaluator-mode* :interpret))
(defun bar (x) (+ x 1)))
But then, I check, and BAR is already compiled :
CL-USER> (compiled-function-p #'bar)
T
So, how do you create an interpreted version of BAR ?
The let form in your question only sets the evaluator mode at runtime. By then, the function has already been compiled.
You need to set it at load time and also make sure to load the file instead of compiling then loading it.
Try this:
In your-file.lisp:
;; at load time, set evaluator mode to interpret (before bar definition is met)
(eval-when (:load-toplevel :execute)
(setf sb-ext::*evaluator-mode* :interpret))
;;define your interpreted function
(defun bar (x)
(+ x 1))
;; set evaluator back to compile mode (optional)
(eval-when (:load-toplevel :execute)
(setf sb-ext::*evaluator-mode* :compile))
;;check if bar is a compiled function
(print (compiled-function-p #'bar)) ;;prints NIL
Then load it with (load "your-file.lisp") (this doesn't compile the file first).
I think that *evaluator-mode* is pretty inherently a global variable. For instance, if you do this:
> (setf sb-ext:*evaluator-mode* ':interpret)
:interpret
> (setf (symbol-function 'bar)
(lambda (x) x))
#<interpreted-function nil {10026E7E2B}>
> (compiled-function-p #'bar)
nil
you get an interpreted function. But if you do this:
> (setf sb-ext:*evaluator-mode* ':compile)
:compile
> (setf (symbol-function 'bar)
(let ((sb-ext:*evaluator-mode* ':interpret))
(lambda (x) x)))
#<function (lambda (x)) {52C3687B}>
> (compiled-function-p #'bar)
t
You don't. My take on this, which may be wrong, is that the value which is in effect at the start of each top-level form is what counts: once the system has decided that it's going to use the compiling-evaluator for a form then it can't change its mind.
And note that there is a complicated definition of 'top-level form', and in particular that when processing a file then in a form like
(let (...)
(x ...))
then (x ...) is not a top-level form.
I'm still quite new to Common Lisp macros.
For an abstraction over a defclass with defgeneric I thought it'd be nice to make a macro.
A complitely naive implementation looks like:
(defmacro defgserver (name &key call-handler cast-handler)
"TODO: needs firther testing. Convenience macro to more easily create a new `gserver' class."
`(progn
(defclass ,name (gserver) ())
(defmethod handle-call ((server ,name) message current-state)
,(if call-handler call-handler nil))
(defmethod handle-cast ((server ,name) message current-state)
,(if cast-handler cast-handler nil))))
When used the error says that 'message' is not known.
I'm not sure. 'message' is the name of a parameter of defgeneric:
(defgeneric handle-call (gserver message current-state))
Using the macro I see a warning 'undefined variable message':
(defgserver foo :call-handler
(progn
(print message)))
; in: DEFGSERVER FOO
; (PRINT MESSAGE)
;
; caught WARNING:
; undefined variable: COMMON-LISP-USER::MESSAGE
Which when used has this consequence:
CL-USER> (defvar *my* (make-instance 'foo))
*MY*
CL-USER> (call *my* "Foo")
<WARN> [10:55:10] cl-gserver gserver.lisp (handle-message fun5) -
Error condition was raised on message processing: CL-GSERVER::C: #<UNBOUND-VARIABLE MESSAGE {1002E24553}>
So something has to happen with message and/or current-state.
Should they be interned into the current package where the macro is used?
Manfred
The problem, as mentioned, is that you are talking about different symbols.
However this is really a symptom of a more general problem: what you are trying to do is a sort of anaphora. If you fixed up the package structure so this worked:
(defgserver foo :call-handler
(progn
(print message)))
Then, well, what exactly is message? Where did it come from, what other bindings exist in that scope? Anaphora can be useful, but it also can be a source of obscure bugs like this.
So, I think a better way to do this, which avoids this problem is to say that the *-handler options should specify what arguments they expect. So instead of the above form you'd write something like this:
(defgserver foo
:call-handler ((server message state)
(print message)
(detonate server)))
So here, value of the :call-handler-option is the argument list and body of a function, which the macro will turn into a method specialising on the first argument. Because the methods it creates have argument lists provided by the user of the macro there's never a problem with names, and there is no anaphora.
So, one way to do that is to do two things:
make the default values of these options be suitable for processing into methods without any special casing;
write a little local function in the macro which turns one of these specifications into a suitable (defmethod ...) form.
The second part is optional of course, but it saves a little bit of code.
In addition to this I've also done a slightly dirty trick: I've changed the macro definition so it has an &body option, the value of which is ignored. The only reason I've done this is to help my editor indent it better.
So, here's a revised version:
(defmacro defgserver (name &body forms &key
(call-handler '((server message current-state)
(declare (ignorable
server message current-state))
nil))
(cast-handler '((server message current-state)
(declare (ignorable
server message current-state))
nil)))
"TODO: needs firther testing. Convenience macro to more easily
create a new `gserver' class."
(declare (ignorable forms))
(flet ((write-method (mname mform)
(destructuring-bind (args &body decls/forms) mform
`(defmethod ,mname ((,(first args) ,name) ,#(rest args))
,#decls/forms))))
`(progn
(defclass ,name (gserver) ())
,(write-method 'handle-call call-handler)
,(write-method 'handle-cast cast-handler))))
And now
(defgserver foo
:call-handler ((server message state)
(print message)
(detonate server)))
Expands to
(progn
(defclass foo (gserver) nil)
(defmethod handle-call ((server foo) message state)
(print message)
(detonate server))
(defmethod handle-cast ((server foo) message current-state)
(declare (ignorable server message current-state))
nil))
I am working on a function that transforms an alist into a query parameters. So far it looks like this.
(defun encode-options (opts)
"Turns an alist into url query parameters."
(format nil "~{~{~A=~A~}~^&~}" opts))
This works perfectly for alists like ((a b) (c d)) (Resulting in "A=B&C=D"), but fails for dotted alists like ((a . b) (c . d)). (Resulting in The value B is not of type LIST.)
My question is: Is it possible to format the dotted alist to give me the expected results and how?
Is it possible to format the dotted alist?
No, format iterates over proper lists.
There are many possible ways to implement what you want. Here I present two of them.
Keep control string, change data
(defun ensure-proper-list (value)
(typecase value
(null nil)
(cons (cons (car value)
(ensure-proper-list (cdr value))))
(t (list value))))
Now, you transform the option argument so that all elements are proper lists:
(defun encode-options (options)
"Turns an alist into url query parameters."
(format nil
"~{~{~A=~A~}~^&~}"
(mapcar #'ensure-proper-list options)))
Keep data, change control string
(defun print-alist (stream data &optional colonp atsignp)
(declare (ignore colonp atsignp))
(destructuring-bind (head . tail) data
(format stream "~A=~A" head (if (consp tail) (first tail) tail))))
With this new format control, print the list as given:
(defun encode-options (options)
"Turns an alist into url query parameters."
(format nil
"~{~/lib:print-alist/~^&~}"
options))
Note that I added a package prefix lib because without a package, print-alist would be looked up in the user package (a.k.a. COMMON-LISP-USER), which in my opinion is rarely what you want. From 22.3.5.4 Tilde Slash: Call Function:
The function corresponding to a ~/name/ directive is obtained by
looking up the symbol that has the indicated name in the indicated
package. If name does not contain a ":" or "::", then the whole name
string is looked up in the COMMON-LISP-USER package.
That's why I would recommend to always mention the package with ~/ directives.
I am looking for a general way for Emacs to do some checks, and (bing) when something is true or false.
I have 2 examples at the moment. There is an auction website, and I figured it would be nice for Emacs to check whether there has been an update. I did this using R (Emacs-ESS) to load source code of the website. Then I use a selfmade function in Emacs to:
Switch buffer, reload the URL info, send the info to the screen, (sleep-for ) to wait a little. Search for "Today". Then it has to check the value after this string, if it is higher than 0, then it means I have something new of interest, and it PINGS.
This is a long introduction, but I really like that this works.
I now do the same with Gnus, I have a timer that runs a function that opens Gnus every 10 seconds, searches for "Inbox", checks the value, and if it is higher than 0 then it notifies me (otherwise it just switches the buffer back). The only problem is that this takes around 0.5 seconds, in which you can see point move to another buffer and switch back.
Is there a general approach to have these automated things be done, without disturbing the user?
EDIT: Wouldn't it be nice for Emacs to perform a check to see whether there is a new post with our favorite tag here on Stackoverflow?
Emacs is single-threaded, so we are screwed - there is not way to do this without bothering the user at all.
The trick is to select a good balance between the frequency and cost of the check so that the user can bear it.
Here is the code I used once:
(defvar sds-new-mail-line nil "cache")
(defun sds-new-mail-line (&optional arg)
"add or remove the mode-line new-mail marker"
(or sds-new-mail-line (error "sds-new-mail-line has not been initialized"))
(let* ((mlf (default-value 'mode-line-format))
(already-have (eq sds-new-mail-line (car mlf))))
(if (or (eq arg nil) (< arg 0))
(when already-have
(setq-default mode-line-format (cdr mlf)))
(unless already-have
(setq-default mode-line-format (cons sds-new-mail-line mlf))))))
(defun sds-gnus-scan-mail ()
"check for new mail, notify if there is some"
(when (gnus-alive-p)
(with-current-buffer gnus-group-buffer
(gnus-group-get-new-news 3)
(gnus-group-get-new-news 2)
(goto-char (point-min))
;; look for new messages in groups of level 1 and 2
(cond ((search-forward-regexp "^ *s[12] *[1-9][0-9]*n" nil t)
(message "you have new mail! (%s)" (user-time-format))
(sds-new-mail-line 1)
(ding))
(t (sds-new-mail-line -1)
(message "no new mail (%s)" (user-time-format))))
(goto-char (point-min)))))
(defun sds-gnus-load-hook ()
(unless sds-new-mail-line ; init
(let ((str "mail") (map (make-sparse-keymap)))
(define-key map [mode-line down-mouse-1] 'ignore)
(define-key map [mode-line mouse-1] read-mail-command)
(add-text-properties 0 (length str)
(list 'display gnus-mode-line-image-cache
'help-echo "you have new mail - read it!"
'local-map map)
str)
(setq sds-new-mail-line str))
(gnus-demon-add-handler 'sds-gnus-scan-mail 3 t))
(add-hook 'gnus-summary-prepared-hook 'gnus-summary-first-unread-subject)
(add-hook 'gnus-summary-prepare-exit-hook 'gnus-summary-catchup))
;; cannot use gnus-load-hook here!
(eval-after-load "gnus-start" '(sds-gnus-load-hook))
I am sure you can adapt it to your needs.
I have a set of functions named "ip", "date", "url" etc.
With these, I want to generate another set of functions "ip-is", "date-is" etc.
I finally have the following solution, thats working fine, but that uses "eval".
(loop for name in '(ip date url code bytes referer user-agent) do
(let ((c-name (intern (concatenate 'string (symbol-name name) "-IS"))))
(eval `(defun ,c-name (c)
#'(lambda (l) (equal (,name l) c))))))
Can someone help me, how to get rid of the "evil eval"? It is essential for my program that the function names are provided as a list. So a call to some marcro
(define-predicate ip)
(define-predicate date)
(define-predicate url)
etc.
would not fit my needs. I have no real problem with "eval", but I read very often, that eval is considered bad style and should be avoided if possible.
Thanks in Advance!
You should use a macro here. Macros are evaluated during compile (or load) and can be used to programatically generate a function definition. Your code could be written something like this:
(defmacro define-predicates (&rest names)
`(progn
,#(loop
for name in names
collect (let ((c-sym (gensym))
(l-sym (gensym)))
`(defun ,(intern (concatenate 'string (symbol-name name) "-IS")) (,c-sym)
#'(lambda (,l-sym) (equal (,name ,l-sym) ,c-sym)))))))
(define-predicates ip date url)
Note that the symbols are generated using GENSYM in the functions. In this particular case, that's not strictly necessary, but I usually prefer to do it this way just so that there is no chance of having any leaking if I were to refactor the code at a later stage.
If you want to use a function (instead of a macro as in the other answer), you should be using (setf fdefinition):
(loop for name in '(ip date url code bytes referer user-agent) do
(let ((c-name (intern (concatenate 'string (symbol-name name) "-IS"))))
(setf (fdefinition c-name)
(lambda (c) (lambda (l) (equal (funcall name l) c))))))