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.
Related
From SBCL's documentation, we can learn:
Invokes the signal facility on a condition formed from DATUM and
ARGUMENTS. If the condition is not handled, NIL is returned.
It does not elaborate on what signal returns in case of a handled condition.
So, I assumed (guessed), that the handler can somehow determine the return value of the signal function:
(defun countdown (&optional
(start-value 10)
(fail-value 1))
(loop
repeat start-value
for i from 0
collecting
(if (= i fail-value)
(signal "fail-value (~D) hit!" i)
i)))
(defun countdown-progress-indicator-style (&optional
(start-value 10)
(fail-value 1))
(handler-bind
((simple-condition (lambda (c)
(format t "fail (~A)~%" c)
fail-value))) ;; <--- I hoped the return value of the handler is returned by signal!
(countdown start-value fail-value)))
But: even if handled, signal returns nil.
(countdown-progress-indicator-style)
fail (fail-value (1) hit!)
(0 NIL 2 3 4 5 6 7 8 9)
Hence, my question, if there is a function or mechanism I missed, which allows the handler to influence signal's return value.
I think the CLHS explains it nicely: in order to handle a condition, you need to transfer control. This can be all kinds of things, but the usual way is to invoke a restart.
(defun countdown (&optional
(start-value 10)
(fail-value 1))
(loop repeat start-value
for i from 0
collecting
(restart-case
(if (= i fail-value)
(signal "fail-value (~D) hit!" i)
i)
(use-fail-value (fv)
fv))))
(defun countdown-progress-indicator-style (&optional
(start-value 10)
(fail-value 1))
(handler-bind
((simple-condition (lambda (c)
(format t "Handling simple condition~%")
(apply #'format t
(simple-condition-format-control c)
(simple-condition-format-arguments c))
(invoke-restart 'use-fail-value
(first (simple-condition-format-arguments c))))))
(countdown start-value fail-value)))
This somewhat abuses simple-conditions arguments; you should probably make your own condition, which takes the value explicitly.
Another way to put it is that you made a nice discovery. You can signal an exceptional situation, have it processed by handler-bind, and carry on execution (or choose not to by using restarts).
With handler-case, you can exit early with a return value.
(handler-case (countdown 3)
(simple-condition ()
(print :exiting-now!)))
;;=>
:EXITING-NOW!
:EXITING-NOW!
If a condition is signaled for which there is an appropriate error-clause during the execution of expression and if there is no intervening handler for a condition of that type, then control is transferred to the body of the relevant error-clause.
http://clhs.lisp.se/Body/m_hand_1.htm#handler-case
A simple reflection warning example:
lein repl
user=> (set! *warn-on-reflection* true)
true
user=> (eval '(fn [x] (.length x)))
Reflection warning, NO_SOURCE_PATH:1:16 - reference to field length can't be resolved.
#object[user$eval2009$fn__2010 0x487ba4b8 "user$eval2009$fn__2010#487ba4b8"]
I want to make this into a function. But where do reflection warnings go?
//clojure/compile.java 63
RT.errPrintWriter()
.format("Reflection warning, %s:%d:%d - reference to field %s can't be resolved.\n",
SOURCE_PATH.deref(), line, column, fieldName);
//clojure/RT.java 269
public static PrintWriter errPrintWriter(){
Writer w = (Writer) ERR.deref();
//clojure/RT.java 188
final static public Var ERR =
Var.intern(CLOJURE_NS, Symbol.intern("*err*"),
new PrintWriter(new OutputStreamWriter(System.err), true)).setDynamic();
Ok so they go to System.err. Lets capture it's output:
(def pipe-in (PipedInputStream.))
(def pipe-out (PipedOutputStream. pipe-in))
(System/setErr (PrintStream. pipe-out))
(defn reflection-check [fn-code]
(binding [*warn-on-reflection* true]
(let [x (eval fn-code)
;_ (.println (System/err) "foo") ; This correctly makes us return "foo".
n (.available pipe-in)
^bytes b (make-array Byte/TYPE n)
_ (.read pipe-in b)
s (apply str (mapv char b))]
s)))
However, calling it gives no warning, and no flushing seems to be useful:
(println "Reflection check:" (reflection-check '(fn [x] (.length x)))) ; no warning.
How can I extract the reflection warning?
You have correctly discovered how *err* is initialized, but since vars are rebindable this is no guarantee about its current value. The REPL often rebinds it to something else, e.g. a socket. If you want to redirect it yourself, you should simply rebind *err* to a Writer of your choosing.
Really I'm not sure your approach would work even if *err* were never rebound. The Clojure runtime has captured a pointer to the original value of System.err, and then you ask the Java runtime to use a new value for System.err. Clojure certainly won't know about this new value. Does the JRE maintain an extra level of indirection to allow it to do these swaps behind the scenes even for people who have already captured System.err? Maybe, but if so it's not documented.
I ran into a similar problem a while back and created some helper functions modelled on with-out-str. Here is a solution to your problem:
(ns tst.demo.core
(:use tupelo.core tupelo.test) )
(defn reflection-check
[fn-code]
(let [err-str (with-err-str
(binding [*warn-on-reflection* true]
(eval fn-code)))]
(spyx err-str)))
(dotest
(reflection-check (quote (fn [x] (.length x)))))
with result:
-------------------------------
Clojure 1.10.1 Java 14
-------------------------------
err-str => "Reflection warning, /tmp/form-init3884945788481466752.clj:12:36
- reference to field length can't be resolved.\n"
Note that binding and let forms can be in either order and still work.
Here is the source code:
(defmacro with-err-str
"Evaluates exprs in a context in which *err* is bound to a fresh
StringWriter. Returns the string created by any nested printing
calls."
[& body]
`(let [s# (new java.io.StringWriter)]
(binding [*err* s#]
~#body
(str s#))))
If you need to capture the Java System.err stream, it is different:
(defmacro with-system-err-str
"Evaluates exprs in a context in which JVM System/err is bound to a fresh
PrintStream. Returns the string created by any nested printing calls."
[& body]
`(let [baos# (ByteArrayOutputStream.)
ps# (PrintStream. baos#)]
(System/setErr ps#)
~#body
(System/setErr System/err)
(.close ps#)
(.toString baos#)))
See the docs here.
There are 5 variants (plus clojure.core/with-out-str):
with-err-str
with-system-out-str
with-system-err-str
discarding-system-out
discarding-system-err
Source code is here.
All the basic examples for Application Delivery show how to replace the toplevel function with your own. Once that function is done, the application exits. I was wondering what's the best way to create a toplevel function for an application that is long running. My code is
(ql:quickload :my-app)
(defun main ()
(swank:create-server :dont-close t)
(my-app:start-server) ; Essentially creates a hunchentoot handler and returns
(loop for x = (read-line)
when (string= x "q") do (quit)
do (format t "Type q to quit~%" x)))
(save-application "my-app" :toplevel-function #'main :prepend-kernel t)
Is there a better way? I don't like the loop but something which frees up the terminal is also ok.
As you say, once the main function is done, the application exits. Ergo, you need to keep the function running until you wish to exit the application.
The simplest solution is to just leave the main loop in an infinite loop of sleep:
(defun main ()
(swank:create-server :dont-close t)
(my-app:start-server)
(loop (sleep 60)))
As you are starting a Swank server, you might want to include functionality for cleanly exiting the application through a SLIME connection. You could, for example, write something like the following, using the bt-semaphore package:
(defvar *quit-my-app* (bt-semaphore:make-semamphore))
(defun main ()
(swank:create-server :dont-close t)
(my-app:start-server)
(bt-semaphore:wait-on-semaphore *quit-my-app*)
(my-app:clean-up)) ; or whatever you need to do for cleaning up
(defun quit-my-app ()
(bt-semaphore:signal-semaphore *quit-my-app*))
Now you can simply evaluate (quit-my-app) on a SLIME connection to shut down the application.
You could also use the main thread for maintenance duties. In my server, I perform simple log rotation there:
(defun seconds-until-tomorrow ()
(multiple-value-bind (second minute hour day month year daylight-p zone)
(decode-universal-time (+ (get-universal-time) (* 60 60 26))) ; safely tomorrow
(declare (ignore second minute hour daylight-p))
(- (encode-universal-time 0 0 0 day month year zone)
(get-universal-time))))
(defun main ()
(swank:create-server :dont-close t)
(let (cur-logfile
cur-logfile-name
;; assuming that start-server returns the Hunchentoot acceptor
(acpt (my-app:start-server)))
(loop
(let* ((lf-stem (log-file-name))
(logfile-name (merge-pathnames lf-stem *temp-path*))
(new-logfile (open logfile-name :direction :output
:if-exists :append
:if-does-not-exist :create)))
(setf (hunchentoot:acceptor-message-log-destination acpt) new-logfile
(hunchentoot:acceptor-access-log-destination acpt) new-logfile)
(when cur-logfile
(close cur-logfile)
(run-program "/usr/bin/xz" (list (princ-to-string cur-logfile-name))))
(setf cur-logfile new-logfile
cur-logfile-name logfile-name)
(when (bt-semaphore:wait-on-semaphore *quit-my-app* (seconds-until-tomorrow))
(return)))))
I am curious how
(write
(make-instance 'simple-error
:format-control "A:~a ~% B:~a~%"
:format-arguments `("A" "B"))
:stream nil)
works, as I tried to implement it myself to gain experience in basic lisp funcionality but soon had to realize, that I am not able to. As the intuitive way of implementation:
(defmethod my-write ((simple-error err))
(FORMAT nil (if (simple-condition-format-control err)
(simple-condition-format-control err)
"")
(simple-condition-format-arguments err)))
obviously cannot work, as (simple-condition-format-arguments err) returns the list of arguments and therefore, in the example above, "B:~a" does not have a corresponding parameter to print.
So how would I actually implement this method?
You can use apply for this. It takes the function passed as its first argument and applies it to arguments constructed from its other arguments. For example, (apply #'f 1 2) calls (f 1 2), (apply #'f 1 '(2 3)) calls (f 1 2 3) and so on. It's perfectly suited for this situation.
SBCL has a function almost identical to yours:
(defun simple-condition-printer (condition stream)
(let ((control (simple-condition-format-control condition)))
(if control
(apply #'format stream
control
(simple-condition-format-arguments condition))
(error "No format-control for ~S" condition))))
As mentioned by Samuel, you need to use APPLY.
Also note that NIL for the stream in WRITE does something else than in FORMAT. With FORMAT the stream argument NIL causes the output to be returned as a string. With man other output functions, like WRITE, it means standard output.
[solved]
I have something similar with these four functions: base, init, func and some. The func is recursive and calls itself: in the "stop case" it would call some and return its value, then it should return control back to "init", wherefrom it is invoked; the latter being once called from base.
base
-> init
-> func
-> init
-> func
-> some
|
_________+
|
v
; should continue from here (in `func`)
[not anymore]
Instead, after the first call to some, the control is yielded directly to base, skipping what I would expect to be the intermediate (init,func) pair call(s).
I actually tried several simpler cases using block, return and recursion (e.g., "mutual tail-recursive factorial"), and all worked well. I mention that func uses a test helper function that catch a throw (but I tried even an example with (catch 'test (throw 'test 0)), and it was ok); just so whatever could my real program have something causing the issue.
This is elisp: each defun commences with block, and all functions use return, as in the following.
[I switched from using "defun/block" to "defun*"]
(defmacro 4+ (number)
"Add 4 to NUMBER, where NUMBER is a number."
(list 'setq number (list '1+ (list '1+ (list '1+ (list '1+ number))))))
(defmacro 4- (number)
"Subtract 4 from NUMBER, where NUMBER is a number."
(list 'setq number (list '1- (list '1- (list '1- (list '1- number))))))
(defun mesg (s &optional o)
"Use ATAB to tabulate message S at 4-multiple column; next/prev tab if O=1/0."
(when (null o) (setq o 0))
(case o (0 (4- atab)) (1 nil))
(message (concat "%" (format "%d" (+ atab (length s))) "s") s)
(case o (0 nil) (1 (4+ atab))))
(defun* base ()
(let (pack)
(setq atab 0)
(mesg "base->" 1)
(setq pack (init))
(mesg "<-base")))
(defun* init ()
(mesg "init->" 1)
(return-from init (progn (setq temp (func)) (mesg "<-init") temp)))
(defun* func (&optional pack)
(mesg "func->" 1)
(when (not (null pack)) (return-from func (progn (mesg "<+func") pack)))
(when (< 0 (mod (random) 2)); stop case
(return-from func (progn (setq temp (some)) (mesg "<-func") temp)))
(setq pack (init))
(case (mod (random) 2)
(0 (return-from func (progn (mesg "<0func") pack)))
(1 (return-from func (progn (setq temp (func pack)) (mesg "<1func") temp))) ; use tail-recursion instead of `while'
(t (error "foo bar"))))
(defun* some ()
(mesg "some->" 1)
(return-from some (progn (mesg "<-some") (list 2 3 4))))
(base)
The pack variable is my value-list as data structure. I also use func to reiterate itself (in tail-recursive call) with a special accumulating-parameter so that I avoid "imperative" while.
So instead of what I would expect (each > is paired by <)
base->
init->
func->
init->
func->
some->
<-some
<-func
<-init
func-> ; tail-recursion
<+func
<1func
<-init
<-base
my program behaves as follows.
base
-> init
-> func
-> init
-> func
-> some
|
__________________________+
|
v
; control yielded here (to `base`)
[not anymore]
Why is the control yielded too soon back to the start of the program, and not continue in the first call to func, after return from the second call via init?
Appreciate any help,
Sebastian
Looking at your code, it is not clear to me what's the extent of the block in func. If the block includes the whole func definition, then yes, the control reaches func when returning, but the block is skipped completely, hence the function completely, and comes back all the way up where it was called (eventually base). May be that the case?
If that's so, you have to put the code that you want to execute after a return after the block.
EDIT: Looking again at your code, I think you're not using the return as it should be used. For instance in init you have
(block nil
...
(return (func ...)))
This return "cancels" the block, and takes the same effect as not having the block at all, unless some function called in "..." does have a return without a block. So the return here cancels the possible return points of func.
Thanks both for your answer: inserting into my program those messages I tried as with the code I added for explanations revealed there are no defun* problems with elisp, but some things I mistook in design.