Space Station Lambda

(asdf:oos 'asdf:load-op 'asdf)
(asdf:oos 'asdf:load-op 'metatilities)
 
(defun direct-dependencies (component)
  (cdadr (asdf:component-depends-on 'asdf:load-op
                                    (asdf:find-component nil component))))
 
(defun normalize-system-id (id)
  (intern (symbol-name id) "KEYWORD"))
 
(defun %effective-dependencies (components)
  "Helper function."
  (when components
    (remove-duplicates
      (append components
              (%effective-dependencies
                (mapcar #'normalize-system-id
                        (remove-if #'null
                                   (metatilities:flatten
                                     (mapcar #'direct-dependencies
                                             components))))))
      :test #'eq)))
 
(defun effective-dependencies (components)
  "Find all dependencies needed for the list of COMPONENTS
(which may be an atom, too)."
  (let ((components (metatilities:ensure-list components)))
    (set-difference (%effective-dependencies components) components
                    :key #'normalize-system-id)))
 
;; usage
(effective-dependencies :weblocks)
 
(:LW-COMPAT :CLOSER-MOP :MOPTILITIES :METATILITIES-BASE :TRIVIAL-GRAY-STREAMS
 :ASDF-SYSTEM-CONNECTIONS :METABANG-DYNAMIC-CLASSES :FLEXI-STREAMS :CFFI
 :SB-GROVEL :CL-CONTAINERS :METABANG-BIND :CHUNGA :CL-BASE64 :CL-FAD :CL-PPCRE
 :CL+SSL :MD5 :RFC2388 :SB-BSD-SOCKETS :SB-POSIX :URL-REWRITE :PARENSCRIPT
 :FARE-UTILS :METATILITIES :HUNCHENTOOT :CL-WHO :CL-JSON :PURI :FARE-MATCHER
 :CL-CONT :ITERATE)

(load "time.lisp")
;; http://cybertiggyr.com/gene/pdl/time.lisp
;; you could also use, for example, CL-L10N.
 
(defmacro base-bind (unit-var amount (&rest var-and-radix) &body code)
  "Thanks to Alan Crowe for this wonderful macro."
  (if (endp var-and-radix)
    `(let ((,unit-var ,amount)) ,@code)
    (let ((transfer (gensym)))
      `(multiple-value-bind (,transfer ,unit-var)
         (floor ,amount ,(cadar var-and-radix))
         (base-bind ,(caar var-and-radix) ,transfer ,(cdr var-and-radix)
                    ,@code)))))
 
(defun smart-date (then)
  (let ((now (get-universal-time)))
    (base-bind now-sec now ((now-min 60) (now-hour 60) (now-day 24))
      (base-bind then-sec then ((then-min 60) (then-hour 60) (then-day 24))
        (base-bind diff-sec (- now then) ((diff-min 60) (diff-hour 60) (diff-day 24))
          (cond
            ;; add more stuff here (e.g. negative offsets) and modify to suit your needs
            ((> diff-day 6) (CYBERTIGGYR-TIME:format-time nil CYBERTIGGYR-TIME:*FORMAT-TIME-FULL* then))
            ((> diff-day 1) (CYBERTIGGYR-TIME:format-time nil "%A" then))
            ((= diff-day 1) "Yesterday")
            ((> diff-hour 0) (format nil "~Dh~Dm ago" diff-hour diff-min))
            ((> diff-min 0) (format nil "~Dm~Ds ago" diff-min diff-sec))
            (t (format nil "~D seconds ago" diff-sec))))))))
 
; demonstration/test
(loop for offset in (list 36 90 120 130 3599 3600 3601 86400 86500 173000 14290010)
      do (format t "~D: ~A~%" offset (smart-date (- (get-universal-time) offset))))
 
; output:
36: 36 seconds ago
90: 1m30s ago
120: 2m0s ago
130: 2m10s ago
3599: 59m59s ago
3600: 1h0m ago
3601: 1h0m ago
86400: Yesterday
86500: Yesterday
173000: Tuesday
14290010: Sunday, 2008 January 27, 03:06 +1

# current:
16090-04.png       PySolFC_1.png
h3teampysol_20080303103813.jpg  pysol.gif
pysol_420_2.gif 175928_large.jpeg  Pysol.jpg
linux-game-pysol03.png          pysol460_big2.jpg
 
# goal:
pysolfc1.png  pysolfc2.jpeg  pysolfc3.gif
pysolfc4.jpg  pysolfc5.png  pysolfc6.jpg
pysolfc7.png  pysolfc8.gif  pysolfc9.jpg

(loop for file in (directory "*")
     for i from 1
     do (rename-file file (format nil "pysolfc~D" i)))

# here with exclamation mark:
qq!we "often" use "quotes" "here".!

(:a :onclick (format nil "$(\"#content\").load(\"~A.clhp\"); return true;" id))

(defun |#q-reader| (stream sub-char numarg)
  (declare (ignore sub-char numarg))
  (let ((terminator (read-char stream)))
    (loop for ch = (read-char stream)
          until (eql ch terminator)
          collect ch into chars
          finally (return (coerce chars 'string)))))
 
(set-dispatch-macro-character
    #\# #\q #'|#q-reader|)

% clisp -repl qq.lisp
[1]> "foo"
"foo"
[2]> #q|foo|
"foo"
[3]> #q|foo bar baz|
"foo bar baz"
[4]> #q!foo bar baz!
"foo bar baz"
[5]> #q!foo bar "baz!
"foo bar \"baz"
[6]> #q!Hello! world! ; oops
"Hello"
[7]>
*** - SYSTEM::READ-EVAL-PRINT: variable WORLD! has no value

autoload -U url-quote-magic
zle -N self-insert url-quote-magic

#!/bin/sh
#
# from http://osdir.com/ml/audio.ecasound.general/2005-08/msg00002.html
#
# description: removes silence from the beginning and the end
#              of a file
# version: 20050807-1
# usage: ecatrimsilence.sh <inputfile>
 
tmp=ecatrimsilence-tmp.wav
 
if test -e "$tmp" ; then
  echo "error: temp file $tmp exists, unable to continue..."
  exit 1
fi
 
if test ! -e "$1" ; then
  echo "error: input file $1 does not exist, unable to continue..."
  exit 2
fi
 
format=`ecalength -sf "$1"`
 
echo "Trimming file ${1}."
echo "Removing silence at the end..."
ecasound -q -f:${format} -i reverse,"${1}" -o "${tmp}" -ge:1,0,0 -b:256
rm -f "${1}"
echo "Removing silence at the beginning..."
ecasound -q -f:${format} -i reverse,"${tmp}" -o "${1}" -ge:1,0,0 -b:256
rm -f "${tmp}"
echo "Done."
</inputfile>

 
(defparameter *appointment* ...)
 
(defun overdue-p ()
  (>= (get-universal-time) *appointment*))

(let ((orig (fdefinition 'get-universal-time)))
  (setf (fdefinition 'get-universal-time) (lambda () *my-testing-time*))
  (prog1
    (overdue-p) ; you'd run some test checks against the result here
    (setf (fdefinition 'bar) orig)))