Some random code of mine you may find useful or entertaining.
A lot of what follows may suffer from byte decay; a desease more common than tooth decay.
If that's your taste, you may also want to look at my GitHub repository.
(cl:in-package :cl-user) (defpackage :my-milter (:use :common-lisp :milter) (:export #:start-my-milter)) (in-package :my-milter) (defvar *message-counter* 0) (defvar *byte-counter* 0) ;; we specialise the context to add the byte count per message (defclass my-context (milter-context) ((byte-count :accessor ctx-byte-count))) ;; here we add up the byte count per message (defmethod handle-event ((e event-body) (ctx my-context)) (incf (ctx-byte-count ctx) (length (event-body-data e))) keep-going) ;; at the beginning of each message we reset the counter (defmethod handle-event ((e event-mail) (ctx my-context)) (setf (ctx-byte-count ctx) 0) keep-going) ;; at the end of the message we update the global statistics and print ;; a brief report of the situation so far (defmethod handle-event ((e event-end-of-message) (ctx my-context)) (incf *byte-counter* (ctx-byte-count ctx)) (incf *message-counter*) (format t "~ ~:R message of ~A byte~:P~%~ the messages seen so far total ~A byte~:P~%~ for an average of ~A byte~:P per message~%" *message-counter* (ctx-byte-count ctx) *byte-counter* (round *byte-counter* *message-counter*)) (finish-output) (action ctx action-add-header :name "X-Message-Size" :value (format nil "~A" (ctx-byte-count ctx))) accept) (defun start-milter-loop (socket) (be context (make-instance 'my-context :socket socket :events '(:mail :body) :actions '(:add-header)) (server-loop context))) (defun start-my-milter () (let ((*log-file* #P"mymilter.log")) (start-milter 20025 #'start-milter-loop)))Tested on SBCL, CMUCL and CLISP. Requires net4cl.
(ns fourtytoo.demyjtify.gnutp (:require [clojure.test :refer :all]) (:use [fourtytoo.demyjtify.core] [fourtytoo.demyjtify.actions :refer (send-action)] [fourtytoo.demyjtify.events :refer (default-event-handler)])) ;;; Dedicated to the memory of Sir Terence David John Pratchett (def the-header "X-Clacks-Overhead") (define-event-handlers handlers (:header (default-event-handler event (if (.equalsIgnoreCase the-header (event :name)) (assoc context :clacks-overhead true) context))) (:mail (send-action {:action :continue} context) (assoc context :clacks-overhead false)) (:abort (->> (assoc context :clacks-overhead false) (default-event-handler event))) (:end-of-message (when (not (context :clacks-overhead)) (send-action {:action :add-header :name the-header :value "GNU Terry Pratchett"} context)) (default-event-handler event context))) (defn run-sample [& args] (future (start-milter 12315 identity)))
CLPMR provides the same functionalities as procmail but with more flexibility and simplicity, given that the language to describe the rules with is Lisp and not some obscure sequence of characters looking like byte-code. The implementation of things like mailing list servers and document servers is trivial and you don't even need external programs (see this example). MIME content is handled natively.
To compile CLPMR you need a handful of libraries from this
page
(mime4cl, net4cl,
smtp4cl and sclf)
and SBCL or CMUCL. It doesn't depend on C libraries.
getcap primitive. Some other common
primitives are provided (goto, put); see the end of the file.
pack-op which creates an archive (by default
in tar format) of all the files in the system
tag-op which creates an Emacs/Vi tags
file
stat-op which prints some figures about
the system files (from Unix wc)
make-exe-op which writes an executable file
containing all the necessary modules required to run the
system (it works on SBCL and CMUCL, but for the latter you
may need my executable.lisp)
revert-op which removes the files produced by
another operation. By default it reverts the compilation,
which means it deletes the x86f/fasl files
mime4cl-20150207T211851.tbz,
MIME4CL is a MIME library for Common Lisp. It
allows you to craft MIME compliant messages or to parse and
handle them within your program. It doesn't impose arbitrary
limits on the size of the mime messages as long as some
cautions are observed:
CL-USER> (with-open-file (stream #P"./sample.tiff"
:element-type '(unsigned-byte 8))
(tiff::print-tiff-tags (tiff:parse-tiff stream)))
IFD 0:
COMPRESSION = :JPEG
ORIENTATION = 1
X-RESOLUTION = 72
Y-RESOLUTION = 72
RESOLUTION-UNIT = :INCH
JPEG-INTERCHANGE-FORMAT = 7060
JPEG-INTERCHANGE-FORMAT-LENGTH = 9665
Y-CB-CR-POSITIONING = :COSITED
IFD 1:
MAKE = "Panasonic"
MODEL = "DMC-FZ7"
ORIENTATION = 1
X-RESOLUTION = 72
Y-RESOLUTION = 72
RESOLUTION-UNIT = :INCH
SOFTWARE = "Ver.1.0 "
DATE-TIME = "2008:09:12 14:10:48"
Y-CB-CR-POSITIONING = :COSITED
EXIF-IFD:
EXPOSURE-TIME = 1/100
F-NUMBER = 4
EXPOSURE-PROGRAM = :NORMAL
ISO-SPEED-RATINGS = 80
EXIF-VERSION = (2 . 20)
DATE-TIME-ORIGINAL = "2008:09:12 14:10:48"
DATE-TIME-DIGITIZED = "2008:09:12 14:10:48"
COMPONENTS-CONFIGURATION = #(1 2 3 0)
COMPRESSED-BITS-PER-PIXEL = 4
EXPOSURE-BIAS-VALUE = 0
MAX-APERTURE-VALUE = 3
METERING-MODE = :PATTERN
LIGHT-SOURCE = NIL
FLASH = (:FLASH-DISABLED)
FOCAL-LENGTH = 12
FLASHPIX-VERSION = (1 . 0)
COLOR-SPACE = 1
PIXEL-X-DIMENSION = 2816
PIXEL-Y-DIMENSION = 2112
SENSING-METHOD = :ONE-CHIP-COLOR-AREA
FILE-SOURCE = :DSC
SCENE-TYPE = :DIRECT
CUSTOM-RENDERED = NIL
EXPOSURE-MODE = :AUTO
WHITE-BALANCE = :AUTO
DIGITAL-ZOOM-RATIO = NIL
FOCAL-LENGTH-IN-35MM-FILM = 72
SCENE-CAPTURE-TYPE = :STANDARD
GAIN-CONTROL = NIL
CONTRAST = :NORMAL
SATURATION = :NORMAL
SHARPNESS = :NORMAL
CL-USER> (format nil "~32B" (ie3fp:encode-ieee-float -123.456)) "11000010111101101110100101111001" CL-USER> (ie3fp:decode-ieee-float #B11000010111101101110100101111001) -123.456
.emacs file:
(defun cl-indent-be (path state indent-point sexp-column normal-indent) (let ((sexp-start (cadr state)) (current-position (point))) (save-excursion (let ((calculate-indentation (lambda (var-indent val-indent) (let ((i 0)) (+ sexp-column (catch 'return (condition-case nil (while (< (point) current-position) (while (forward-comment 1)) (cond ((and (= 1 (logand i 1)) (looking-at "[\t\n ]*\\s(")) (throw 'return 2)) (t (setq i (1+ i)) (forward-sexp)))) (error nil)) (if (= 1 (logand i 1)) val-indent var-indent))))))) (goto-char sexp-start) (forward-char) (let ((tag (symbol-at-point))) (cond ((eq tag 'be) (funcall calculate-indentation 4 6)) ((eq tag 'be*) (funcall calculate-indentation 5 7)) ;; I couldn't quite understand the logic of ;; common-lisp-indent-function-1 but for some reason ;; the current function can be called to indent forms ;; it wasn't written for. In those cases just return ;; NIL. (t nil))))))) (put 'be 'common-lisp-indent-function 'cl-indent-be) (put 'be* 'common-lisp-indent-function 'cl-indent-be) (put 'awhen 'lisp-indent-function 1) (put 'gcase 'lisp-indent-function 1) (put 'acase 'lisp-indent-function 1) (put 'acond 'lisp-indent-function 1) (put 'until 'lisp-indent-function 1)
iconv library
that lets Common Lisp programs translate byte sequences
from/to different character sets, like this:
(cliconv:iconv (map '(vector (unsigned-byte 8)) #'char-code
"François, piña, böse, skøl")
:ISO-8859-1 :UTF-8)
This package uses UFFI, so it should be fairly portable.
CL-USER> (asdf:oos 'asdf:load-op :currensea) ; [...] NIL CL-USER> (currency:get-quote "USD") 1.2057 CL-USER> (currency:exchange-rate "JPY" "USD") 0.0084 CL-USER> (currency:convert-currency 10000 "BMD" "CNY") 80623.0 CL-USER>
Here is an example:
(ods4cl:make-spreadsheet #P"/tmp/foo.ods" '(("My Sheet" (a b c) (1.2 3.4 5.6) ("foo" "bar" "baz"))))
![[sample spreadsheet]](sheet.png)
(load-library "bencode") (add-hook 'dired-mode-hook #'(lambda () (local-set-key "\C-c\C-t" 'dired-view-torrent)))
Patches to the FreeBSD
system.
@@ -419,13 +423,14 @@ int temp; (void)fd; - if (GETSYSCTL("hw.acpi.thermal.tz0.temperature", temp)) { - fprintf(stderr, - "Cannot read sysctl \"hw.acpi.thermal.tz0.temperature\"\n"); - return 0.0; - } - - return KELVTOC(temp); + if (0 == GETSYSCTL("hw.acpi.thermal.tz0.temperature", temp)) + return KELVTOC(temp); + if (0 == GETSYSCTL("dev.cpu.0.temperature", temp)) + return KELVTOC(temp); + if (0 == GETSYSCTL("dev.amdtemp.0.core0.sensor0", temp)) + return KELVTOC(temp); + fprintf(stderr, "Cannot read sysctl for temperature\n"); + return 0.0; } static void get_battery_stats(int *battime, int *batcapacity, int *batstate, int *ac) {Strictly speaking, that's probably no longer "ACPI temperature", but you'll get what you are after. This is part of Problem Report 210235.
Index: kern_descrip.c =================================================================== --- kern_descrip.c (revision 276910) +++ kern_descrip.c (working copy) @@ -419,8 +419,10 @@ struct __oflock ofl; intptr_t arg1; int error; + int newcmd; error = 0; + newcmd = cmd; switch (cmd) { case F_OGETLK: case F_OSETLK: @@ -438,13 +440,13 @@ switch (cmd) { case F_OGETLK: - cmd = F_GETLK; + newcmd = F_GETLK; break; case F_OSETLK: - cmd = F_SETLK; + newcmd = F_SETLK; break; case F_OSETLKW: - cmd = F_SETLKW; + newcmd = F_SETLKW; break; } arg1 = (intptr_t)&fl; @@ -462,7 +464,7 @@ } if (error) return (error); - error = kern_fcntl(td, fd, cmd, arg1); + error = kern_fcntl(td, fd, newcmd, arg1); if (error) return (error); if (cmd == F_OGETLK) { Index: freebsd32_misc.c =================================================================== --- freebsd32_misc.c (revision 276910) +++ freebsd32_misc.c (working copy) @@ -3135,6 +3135,9 @@ case F_SETLKW: case F_SETLK: case F_GETLK: + case F_OSETLKW: + case F_OSETLK: + case F_OGETLK: case F_SETFD: case F_SETFL: tmp = (unsigned int)(uap->arg);
nodump_coredump sysctl variable set the
kernel creates core files with the NODUMP flag
set.
usbd daemon, as it is, is not suitable to
handle devices implementing multiple features, like
USB->PS/2 converters, docking stations, or such. Here is
a patch that changes this behaviour
and will make usbd match multiple entries
in usbd.conf. The original behaviour is still
there, you just have to use the -s flag.
ums.c kernel module to make MCT and possibly
other PS/2->USB devices work properly under FreeBSD.
apm_event POWERSTATECHANGE {
exec "/bin/sh /usr/local/bin/handle-power-change";
}
and do fancy things like dimming the back light of the LCD
screen to save energy when you are not connected to the mains.
ls formats the columns rigidly regardless
whether the date displays the time or the year. In that case
here's how to fix your dired-mode:
;; Return the number of spaces before the filename on a dired line ;; (which is an ls line). (defun dired-count-spaces-before-filename () (let* ((ls (shell-command-to-string "ls -ld")) (pos (- (length ls) 2))) (assert (= ?. (aref ls pos))) (setq pos (1- pos)) (while (char-equal ?\ (aref ls pos)) (setq pos (1- pos))) (- (length ls) pos 3))) ;; If necessary correct the directory-listing-before-filename-regexp (let ((spaces (dired-count-spaces-before-filename)) (re directory-listing-before-filename-regexp)) ;; Check we haven't done it yet.... (when (char-equal ?+ (aref re (1- (length re)))) ;; Remove the + at the end of the regexp, that would match more ;; than one space, and append a string o spaces in its stead. (setq directory-listing-before-filename-regexp (concat (substring re 0 (1- (length re))) (make-string (1- spaces) ?\ )))))Don't forget to check if
dired-listing-switches
might help with special characters, as well.
Igorplug was written mainly because LIRC, which supports this device, is too Linux-centric. This program doesn't work with LIRC. Igorplug intends to be a replacement for LIRC, but is limited to this device; you may notice that most of what you need is already implemented.
Igorplug is not much documented but it should be quite straightforward to use.
igor_broadcast broadcasts the received
infrared sequences via UDP to a specific host and port.
Default is localhost on
port 5253.
igor_echo prints on standard output the IR
sequences it receives from a device. This is useful to
compile a configuration file for the following programs.
igor_inject converts IR sequences into
X-events and sends them to a specific window or any
window currently in focus. This uses a configuration
file containing the association of sequences and events.
igor_pty converts IR sequences into
keystrokes that are sent to a child program, which is
specified as argument. This uses a configuration file
containing the association of sequences and keystrokes.
abcd + cdef = abcdef.
-o is given, files are concatenated
after the end of the first (modifying it).
Copyright © Walter C. Pelissero, all rights reserved