NEW: For a prettier blog interface, see the Wordpress version!
- More hacks for mangling Japanese CSV 10:06
- Japanese flashcards 11:53
- Code to print function definitions for code not associated with a file 15:11
- Straight redefinition of describe-function-1 15:20
- Cat -- 55 words 18:52
- planner-multi-read-name 20:02
- Proof of concept: Deleting private tasks 20:41
- Testing testing testing 21:09
- New icons 21:19
~/.diary schedule
No entries
Tasks
| B | X | Make plan pages optional (PlannerModeMaintenance) |
| B | X | Fix Japanese locale, really!: Chat with :Dabian on niven.freenode.net%23emacs (PlannerModeMaintenance) |
| B | X | Fix locale again: E-Mail from sf (PlannerModeMaintenance) |
| B | X | Make multiple pages use spaces or parentheses : E-Mail from Michael Olson (PlannerModeMaintenance) |
| B | X | Send GNU papers for ERC |
Notes
1. More hacks for mangling Japanese CSV
(defun sacha/kanji/get-ordered-kanji-list ()
(let (kanji-list)
(while (not (eobp))
(let ((c (char-after (point))))
(cond
((= c ?\"))
((= c ?\n))
((= c ?:) (forward-line 1) (forward-char -1))
(t (add-to-list 'kanji-list c))))
(forward-char 1))
kanji-list))
(defun sacha/kanji/ordered-usefile-to-kill ()
(interactive)
;; Look up kanji in kanjidic
(let ((list (sacha/kanji/get-ordered-kanji-list)))
(kill-new
(with-current-buffer (find-file-noselect "/usr/share/edict/kanjidic")
(mapconcat
(lambda (kanji)
(goto-char (point-min))
(when (search-forward (char-to-string kanji) nil t)
(skip-syntax-forward " ")
(buffer-substring-no-properties (point) (and (skip-syntax-forward "^ ") (point)))))
list
"\n")))))
2. Japanese flashcards
(defun sacha/kanji/get-ordered-kanji-list ()
"Return a list of characters in the buffer."
(goto-char (point-min))
(let (kanji-list)
(while (not (eobp))
(let ((c (char-after (point))))
(when (>= c ?亜) (add-to-list 'kanji-list c)))
(forward-char 1))
kanji-list))
(defun sacha/kanji/to-flashcard-j2e (&optional list)
"Return a Japanese-English flashcard set.
If LIST is non-nil, use that instead of the current buffer."
(interactive (list (sacha/kanji/get-ordered-kanji-list)))
(unless list (setq list (sacha/kanji/get-ordered-kanji-list)))
(let ((result
(with-current-buffer (find-file-noselect "/usr/share/edict/kanjidic")
(mapconcat
(lambda (kanji)
(goto-char (point-min))
(when (re-search-forward (format "^%c.*?{\\(.*\\)}" kanji) nil t)
(format "%c : %s\n"
kanji
(replace-regexp-in-string "}\\s-+{" "," (match-string 1)))))
list
""))))
(if (interactive-p) (kill-new result) result)))
(defun sacha/flashcard-method-leitner-check-answer (card answer)
"Check answer for correctness. Allow multiple correct answers and provide feedback."
(if (member answer (split-string (flashcard-card-answer card) ","))
(progn
(flashcard-insert "Correct! Answer is:\n"
(propertize (flashcard-card-answer card)
'face 'flashcard-answer-face
'rear-nonsticky t)
"\n"
"\n")
t)
(flashcard-insert "The correct answer is:\n"
(propertize (flashcard-card-answer card)
'face 'flashcard-answer-face
'rear-nonsticky t)
"\n"
"\n")
(y-or-n-p "Was your answer correct? ")))
(setq flashcard-method-check-answer-function 'sacha/flashcard-method-leitner-check-answer)
(add-to-list 'auto-mode-alist '("\\.deck\\'" . flashcard-mode))
(add-hook 'flashcard-mode-hook 'flashcard-add-scroll-to-bottom)
(add-hook 'flashcard-positive-feedback-functions 'flashcard-feedback-highlight-answer)
(add-hook 'flashcard-positive-feedback-functions 'flashcard-feedback-congratulate)
(add-hook 'flashcard-positive-feedback-functions 'flashcard-method-leitner-positive-feedback)
3. Code to print function definitions for code not associated with a file
(defadvice describe-function-1 (after sacha activate)
(let ((def (if (symbolp function)
(symbol-function function)
function))
file-name)
;; START OF CODE EXTRACTED FROM describe-function-1
(and (eq (car-safe def) 'autoload) (setq file-name (nth 1 def)))
(or file-name (setq file-name (symbol-file function)))
(when (equal file-name "loaddefs.el")
;; Find the real def site of the preloaded function.
;; This is necessary only for defaliases.
(let ((location
(condition-case nil
(find-function-search-for-symbol function nil "loaddefs.el")
(error nil))))
(when location
(with-current-buffer (car location)
(goto-char (cdr location))
(when (re-search-backward
"^;;; Generated autoloads from \\(.*\\)" nil t)
(setq file-name (match-string 1)))))))
(when (and (null file-name) (subrp def))
;; Find the C source file name.
(setq file-name (if (get-buffer " *DOC*")
(help-C-file-name def 'subr)
'C-source)))
;; START NEW CODE
(or file-name
(with-current-buffer standard-output
(insert "\n\nDefinition file not found, so inserting definition here.\n\n")
(prin1 (symbol-function function))))))
Chat with :edrx on sterling.freenode.net%23emacs
On Technorati: emacs
4. Straight redefinition of describe-function-1
(defun describe-function-1 (function)
(let* ((def (if (symbolp function)
(symbol-function function)
function))
file-name string
(beg (if (commandp def) "an interactive " "a ")))
(setq string
(cond ((or (stringp def)
(vectorp def))
"a keyboard macro")
((subrp def)
(if (eq 'unevalled (cdr (subr-arity def)))
(concat beg "special form")
(concat beg "built-in function")))
((byte-code-function-p def)
(concat beg "compiled Lisp function"))
((symbolp def)
(while (symbolp (symbol-function def))
(setq def (symbol-function def)))
(format "an alias for `%s'" def))
((eq (car-safe def) 'lambda)
(concat beg "Lisp function"))
((eq (car-safe def) 'macro)
"a Lisp macro")
((eq (car-safe def) 'autoload)
(setq file-name (nth 1 def))
(format "%s autoloaded %s"
(if (commandp def) "an interactive" "an")
(if (eq (nth 4 def) 'keymap) "keymap"
(if (nth 4 def) "Lisp macro" "Lisp function"))
))
((keymapp def)
(let ((is-full nil)
(elts (cdr-safe def)))
(while elts
(if (char-table-p (car-safe elts))
(setq is-full t
elts nil))
(setq elts (cdr-safe elts)))
(if is-full
"a full keymap"
"a sparse keymap")))
(t "")))
(princ string)
(with-current-buffer standard-output
(save-excursion
(save-match-data
(if (re-search-backward "alias for `\\([^`']+\\)'" nil t)
(help-xref-button 1 'help-function def)))))
(or file-name
(setq file-name (symbol-file function)))
(when (equal file-name "loaddefs.el")
;; Find the real def site of the preloaded function.
;; This is necessary only for defaliases.
(let ((location
(condition-case nil
(find-function-search-for-symbol function nil "loaddefs.el")
(error nil))))
(when location
(with-current-buffer (car location)
(goto-char (cdr location))
(when (re-search-backward
"^;;; Generated autoloads from \\(.*\\)" nil t)
(setq file-name (match-string 1)))))))
(when (and (null file-name) (subrp def))
;; Find the C source file name.
(setq file-name (if (get-buffer " *DOC*")
(help-C-file-name def 'subr)
'C-source)))
(when file-name
(princ " in `")
;; We used to add .el to the file name,
;; but that's completely wrong when the user used load-file.
(princ (if (eq file-name 'C-source) "C source code" file-name))
(princ "'")
;; Make a hyperlink to the library.
(with-current-buffer standard-output
(save-excursion
(re-search-backward "`\\([^`']+\\)'" nil t)
(help-xref-button 1 'help-function-def function file-name))))
(princ ".")
(terpri)
(when (commandp function)
(let* ((remapped (command-remapping function))
(keys (where-is-internal
(or remapped function) overriding-local-map nil nil))
non-modified-keys)
;; Which non-control non-meta keys run this command?
(dolist (key keys)
(if (member (event-modifiers (aref key 0)) '(nil (shift)))
(push key non-modified-keys)))
(when remapped
(princ "It is remapped to `")
(princ (symbol-name remapped))
(princ "'"))
(when keys
(princ (if remapped " which is bound to " "It is bound to "))
;; FIXME: This list can be very long (f.ex. for self-insert-command).
;; If there are many, remove them from KEYS.
(if (< (length non-modified-keys) 10)
(princ (mapconcat 'key-description keys ", "))
(dolist (key non-modified-keys)
(setq keys (delq key keys)))
(if keys
(progn
(princ (mapconcat 'key-description keys ", "))
(princ ", and many ordinary text characters"))
(princ "many ordinary text characters"))))
(when (or remapped keys non-modified-keys)
(princ ".")
(terpri))))
(let* ((arglist (help-function-arglist def))
(doc (documentation function))
(usage (help-split-fundoc doc function)))
(with-current-buffer standard-output
;; If definition is a keymap, skip arglist note.
(unless (keymapp def)
(let* ((use (cond
(usage (setq doc (cdr usage)) (car usage))
((listp arglist)
(format "%S" (help-make-usage function arglist)))
((stringp arglist) arglist)
;; Maybe the arglist is in the docstring of the alias.
((let ((fun function))
(while (and (symbolp fun)
(setq fun (symbol-function fun))
(not (setq usage (help-split-fundoc
(documentation fun)
function)))))
usage)
(car usage))
((or (stringp def)
(vectorp def))
(format "\nMacro: %s" (format-kbd-macro def)))
(t "[Missing arglist. Please make a bug report.]")))
(high (help-highlight-arguments use doc)))
(insert (car high) "\n")
(setq doc (cdr high))))
(let ((obsolete (and
;; function might be a lambda construct.
(symbolp function)
(get function 'byte-obsolete-info))))
(when obsolete
(princ "\nThis function is obsolete")
(when (nth 2 obsolete)
(insert (format " since %s" (nth 2 obsolete))))
(insert ";\n"
(if (stringp (car obsolete)) (car obsolete)
(format "use `%s' instead." (car obsolete)))
"\n"))
(insert "\n"
(or doc "Not documented.")))
(unless file-name
(insert "\n\nDefinition hyperlink not found, so inserting definition here.\n\n"
(pp-to-string (symbol-function function))))))))
Chat on sterling.freenode.net%23emacs
On Technorati: emacs
5. Cat -- 55 words
"Neko?" I stroked the cat sleeping on my lap. She yawned, stretched, and curled up around my hand.
"Absolutely antisocial." He shivered. "Psycho. Pure evil."
"Nonsense. She's a darling." I leaned in and whispered, "Just let her think she's boss."
A hiss and a deep scratch told me I wasn't quiet enough. </blockquote>
- In response to the "ABSOLUTELY ANTISOCIAL" prompt on the flashxer mailing list
On Technorati: flashfiction, 55er
6. planner-multi-read-name
7. Proof of concept: Deleting private tasks
(add-to-list 'planner-publishing-markup (lambda () (delete-matching-lines "{{private}}")))
(planner-update-wiki-project)
Fun, isn't it?
8. Testing testing testing
9. New icons
I'd love to hear about any questions, comments, suggestions or links that you might have. Your comments will not be posted on this website immediately, but will be e-mailed to me first. You can use this form to get in touch with me, or e-mail me at sacha@sachachua.com .