;;; LOGBOOK.EL --- Mode to keep a daily logbook.
;;{{{ File info
;; Copyright (C) 1995 Alain Picard
;; Author: Alain Picard ap@abelard.apana.org.au
;; Maintainer: Alain Picard ap@abelard.apana.org.au
;; Created: 17 Sep 1995
;; Version: 1.0 alpha
;; Keywords: HTML logbook
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 1, or (at your option)
;; any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; A copy of the GNU General Public License can be obtained from this
;; program's author (send electronic mail to ap@abelard.apana.org.au) or from
;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
;; 02139, USA.
;; LCD Archive Entry:
;; logbook|Alain Picard|ap@abelard.apana.org.au
;; |Mode to keep a daily logbook in HTML format.
;; |$Date: 2001/05/23 09:14:00 $|$Revision: 0.30 $|~/packages/logbook.el
;;; Commentary:
;;; Change log:
;; $Log: logbook.el,v $
;; Revision 0.30 2001/05/23 09:14:00 ap
;; Index is now rebuilt in reverse chronological order of
;; creation, not modification time.
;;
;; Revision 0.29 1998/06/16 12:54:34 ap
;; Added some preliminary menus.
;; Still to do: sub-menus for the font's and HMTL cookies stuff.
;;
;; Revision 0.28 1998/06/16 12:15:08 ap
;; Added logbook-insert-bibtex-entries function and keybinding.
;;
;; Revision 0.27 1998/05/27 10:13:16 ap
;; Now write only relative paths in the index files.
;;
;; Revision 0.26 1997/11/15 23:22:17 ap
;; Now prints out version number, to help in debugging.
;;
;; Revision 0.25 1997/09/09 11:07:49 ap
;; Strange bug where processing a file would change the value of current
;; working directory. Bug not found, but now process absolute path names
;; in logbook-index-rebuild-index fixes the problem. Still weird
;; though... should try to find out cause of directory change.
;;
;; Revision 0.24 1997/09/03 11:31:50 ap
;; Added new function to add a link to directories
;; called 199? to point to the index file contained
;; therein.
;; Note that this code is not Y2K compliant. :-)
;; HMJ can sue me.
;;
;; Revision 0.25 1996/06/17 10:40:54 ap
;; Fixed wrong email address.
;; Removed extra newline in logbook-textual-string-type-function.
;;
;; Revision 0.24 1996/06/13 10:37:55 ap
;; Fixed a bug where editing an old entry would cause the
;; entire ~/LOGBOOK/ directory to get write-protected.
;; Fix consists of writing the logbook-current-logbook-entry to
;; the list of local variables at the top of each logbook entry.
;;
; Revision 0.23 1995/12/08 15:34:54 ap
; Prettied up the header and trailer strings a little.
;
; Changed the logbook-entry-date from a variable to
; a (logbook-entry-date) function.
;
; Revision 0.22 1995/11/30 13:28:59 ap
; Moved definition of logbook-archive-document-directory to AFTER
; visiting the logbook-entry file. (variable was being set from
; value in a possibly old buffer, and so could be wrong.)
;
; Revision 0.21 1995/11/29 16:22:45 ap
; Fixed a missing paren, introduced in previous revision.
;
; Revision 0.20 1995/11/29 16:20:09 ap
; Keyword index now presented sorted alphabetically.
;
; Revision 0.19 1995/11/29 16:11:16 ap
; Added list inserting commands.
; They're VERY simple and VERY stupid.
; I looked at html-helper-mode, and I'm impressed by
; how hairy it is to do it right. Chapeau to that guy.
;
; Revision 0.18 1995/11/21 12:32:02 ap
; Fixed regexp in logbook-index-process-entry which was causing the
; backward-reference code to sometimes fail (pages pointed to 'nil').
; It now gobbles any trailing whitespace.
;
; Revision 0.17 1995/10/31 15:41:18 ap
; Added slightly more general way of inserting formatting commands.
; These are bound to the C-c C-f keymap, and currently comprises
; t - typewriter
; s - strong
; e - emphasize
; Adding other functions should be easy -- modify
; logbook-html-font-alist and write a function which calls
; logbook-html-insert-font with the appropriate argument, and bind
; that to a key.
;
; Revision 0.16 1995/10/25 13:04:25 ap
; Fixed a bug in which logbook-archive-document-directory got set before
; the entry was find-file'd, resulting in new entries not having this
; variable properly updated.
;
; Revision 0.15 1995/10/23 09:35:42 ap
; Made logbook-archive-document-directory buffer-local, and set it in
; the first line of each entry, so that old entries may be re-edited and
; still know which directories they should save files to. (As per HMJ
; request. :-)
;
;
; Fixed a teeny bug in logbook-dont-archive-regexp (forgot a \\ in front
; of |)
;
; Revision 0.14 1995/10/18 13:37:36 ap
; Added code for automatic compression of saved documents.
; By default, files ending in .gif and .gz are not compressed.
;
; Added code to refuse to exit log entry if a keyword has not been
; entered. This can be disabled by setting logbook-entry-require-keywords
; to nil.
;
; Revision 0.13 1995/10/15 11:14:29 ap
; Added some armor plating to circumvent bug found by gvacanti@bart.nl.
; Code now checks if a dump filename does not end in .gif, it adds it.
; If a thumbnail cannot be made, e.g. the file is not gif or ps, the
; request is silently ignored.
;
; Revision 0.12 1995/10/13 15:21:52 ap
; Added function to referece previous pages. This means adding a
; logbook-reverse-title-page-alist.
;
; Also, I no longer save the logbook-keyword-to-file-alist, I regenerate
; it and logbook-reverse-title-page-alist from their more fundamental
; alists in logbook-index-read-index-data. This permits keeping of
; smaller .logbook.eld files, and probably does not take much time to
; compute each time on the fly.
;
; Added a function to wrap text in text (HMJ request).
; Must make more general, someday.
;
; Revision 0.11 1995/10/12 13:58:25 ap
; Fixed a serious bug in logbook-index-process-entry which prevented
; keywords from being completed properly. (Basically, a
; re-search-forward regexp was wrong).
;
; Added date on title line.
;
; Added code to ensure only 1 entry can be open at a time.
;
; Revision 0.10 1995/10/09 13:04:28 ap
; Title of the page now appears in the mode line.
; Aspect ratio is now preserved when making thumbnail images
; (done by removing the ysize command line argument)
;
; Revision 0.9 1995/10/06 15:50:32 ap
; Added support for linking each entry to the previous one
; through the logbook-most-recent-file variable.
;
; Revision 0.8 1995/10/06 12:42:44 ap
; keyword index code now works.
; preformatted textual stuff now works.
;
; Revision 0.7 1995/10/05 16:20:21 ap
; Rewrote logbook-process-entry to be
; able to handle newlines in strings between
; cookies.
;
; Revision 0.6 1995/10/05 07:40:10 ap
; Stable version.
;
; Revision 0.5 1995/10/04 09:11:47 ap
; logbook-screen-dump written.
;
; logbook-image-type-function modified to clean up
; after itself a bit (now deletes the original thumbnail file)
;
; logbook-make-thumbnail modified to clean up after itself a
; bit (now deletes the .ppm file)
;
; Revision 0.4 1995/10/02 19:57:11 ap
; Indexing now uses lisp symbols.
; Keyword completion works (somewhat). Must
; find out how to make it stop giving filenames
; as possible completions. Sending this
; version to HMJ for alpha testing.
;
; Revision 0.3 1995/09/28 08:31:52 ap
; Rudimentary index generating function written.
; I'll now try to rewrite it keeping all necessary
; variables in lisp structures.
;
; Revision 0.2 1995/09/27 09:41:45 ap
; Cleaned up considerably. Added the
; logbook-object-type-alist to do things in
; a more general fashion.
;
; Revision 0.1 1995/09/26 14:16:52 ap
; *** empty log message ***
;
(defconst logbook-version (substring "$Revision: 0.30 $" 11 -2)
"$Id: logbook.el,v 0.30 2001/05/23 09:14:00 ap Exp $
Report bugs to: Alain Picard ap@abelard.apana.org.au")
;;}}}
;;{{{ Description and usage
;;; logbook-mode is meant to allow you to keep a logbook in HTML
;;; format, without having to worry about inserting HTML code. For
;;; writing pure HTML documents, see functions like html-helper-mode.
;;; This mode is not meant to replace that. The motivation, quite the
;;; contrary, is to let the user never see any HTML syntax. I wanted
;;; a mode in which I could take down notes relating to my scientific
;;; data reductions, and have the ability to point directly to files.
;;; What was missing was the ability to paste in pictures, which I
;;; like to do in my logbooks. When HTML came out, this became
;;; feasible, however I didn't want to spend my time inserting messy
;;; HTML code everywhere (the idea is to concentrate on your work, not
;;; formatting your logbook.)
;;;
;;; logbook-mode provides you with the ability to save documents and
;;; images in an archive directory, writing HTML browseable logbooks
;;; with a mere keystroke. The HTML pages don't look wonderful, but
;;; title and keyword indices are provided.
;;;
;;; Fire up the logbook with logbook-open-logbook. This will create a
;;; new entry (HTML page) which you will use until you hit C-c C-c
;;; (logbook-close-logbook) which saves your entry, makes it
;;; read-only, and writes it out in HTML format. No fuss, no muss.
;;; Type C-h m for a mode description and listing of keystrokes.
;;; Sorry, no documentation yet. :-)
;;;
;;; To use this program, create a directory which will contain your
;;; logbook entries and set logbook-logbook-directory to point to it.
;;; e.g. add (setq logbook-logbook-directory "~/LOGBOOK") in your
;;; .emacs file.
;;;
;;; To make use of the facilities for automatically adding a thumbnail
;;; inlined image of saved graphical documents, you'll need to have to
;;; pbmplus utilities or the netpbm utilities installed on your
;;; system, and set the logbook-pbmplus-directory variable to point to
;;; where those utilities are stored. e.g.
;;; (setq logbook-pbmplus-directory "/usr/foo/pbmplus")
;;; In particular, the programs ppmtogif, ppmquant, pstopnm, giftopnm
;;; and pnmscale are required.
;;;
;;; Byte compile this file and place it somewhere in your load-path,
;;; and add the following autoload to your .emacs:
;;; (autoload 'logbook-open-logbook "logbook.el"
;;; "Open a new entry in the logbook." t)
;;}}}
;;{{{ Enhancing logbook-mode
;;; Adding functionality to logbook-mode:
;;; -------------------------------------
;;;
;;; Interactive functions bound to keystrokes all eval as their last
;;; form one of the following:
;;; (logbook-insert-logbook-delimiter string 'type)
;;; which instructs logbook-insert-logbook-delimiter to add the proper
;;; delimiter around the string. These delimiters will be later
;;; recognized when logbook-close-logbook is run, which calls
;;; logbook-process-logbook-entry. This function is responsible for
;;; deleting the delimiters and calling the appropriate function for
;;; each logbook command.
;;;
;;; Each delimiter has with it associated a function which it knows to
;;; call, with the string sandwiched between the delimiters as
;;; argument. These functions are responsible for inserting the
;;; appropriate HTML code and doing any real action that is
;;; needed. (e.g. copy a document to the archive directory, make a
;;; thumbnail image, whatever.)
;;;
;;; The logbook-object-type-alist contains information about how each
;;; type of data is to be recognized and processed. To add a new type
;;; of document, say foo, add
;;; (cons 'foo-type
;;; (list (cons logbook-foo-string-start logbook-foo-string-end)
;;; 'logbook-foo-type-function))
;;; to this list, and define logbook-foo-string-start and
;;; logbook-foo-string-end to be strings which do not conflict with
;;; existing delimiters, and which are not likely to be used by a
;;; naive user, e.g. "(BEGIN-FOO->" and "<-END-FOO)" would be good
;;; choices. :-)
;;;
;;; You may also with to add highlighting support for those new
;;; cookies with
;;; (hilit-add-pattern logbook-foo-string-start
;;; logbook-foo-string-end
;;; 'favorite-coloring-scheme 'logbook-mode t)
;;}}}
;;{{{ TODO list
;;; - picture function should have option: if C-u - ask for medium,
;;; small or large picture. This is hard.
;;; - Add menu support.
;;; - Add some (more) armor plating :-)
;;; - redefine c-x c-k so that logbook-currently-locked gets properly
;;; redefined when a buffer is killed (or write a
;;; logbook-kill-entry-dont-save kind of function)
;;; - document the logbook-compression stuff and require-keyword stuff.
;;}}}
;;{{{ Code:
;;{{{ User settable variables
(defvar logbook-logbook-directory "~/LOGBOOK/"
"*Directory in which to keep the logbook. Should end in a /.")
(defvar logbook-archive-document-directory nil
"*Directory in which to keep the associated documents.
This should be relative to logbook-logbook-directory. Should end
in a /. If 'nil, a new directory will be created each day.")
(defvar logbook-logbook-index "INDEX.html"
"*File to use as index of the logbook.")
(defvar logbook-logbook-keyword-index "INDEX-KEYWORDS.html"
"*File to use as index of keywords for the logbook.")
(defvar logbook-mode-hook nil
"*Hook to be run after entry into logbook-mode.")
(defvar logbook-always-archive t
"*Compress documents with gzip before saving them if not nil.")
(defvar logbook-dont-archive-regexp "\\.gz$\\|\\.Z$\\|\\.gif$\\|\\.jpg$"
"*Files matching this regexp will not be compressed.")
(defvar logbook-entry-require-keywords t
"*If t, logbook-mode will refuse to exit the logbook if at least one
keyword has not been entered in the log.")
(defvar logbook-pbmplus-directory "/usr/local/netpbm/"
"*Directory containing the pbmplus programs required
to convert images from various format to gif, for automatic inlining.")
(defvar logbook-temp-directory "/tmp/"
"*Directory which holds temporary files created by logbook-mode.")
(defvar logbook-insert-delimiter-hook nil
"*Hook to run after inserting logbook delimiters. This could be set to
'hilit-rehighlight-buffer, for example")
;;}}}
;;{{{ Keymap
(defvar logbook-mode-map nil
"Keymap for logbook mode.")
(defvar logbook-mode-menu
'(["Close the logbook entry" logbook-close-logbook]
["Archive a document" logbook-archive-document]))
(if logbook-mode-map
() ; Do not change the keymap if it is already set up.
(setq logbook-mode-map (make-sparse-keymap))
;; create the `fake' keymap for the menu.
(define-key logbook-mode-map [menu-bar logbook]
(cons "Logbook" (make-sparse-keymap "Logbook")))
(define-key logbook-mode-map "\C-c\C-c" 'logbook-close-logbook)
(define-key logbook-mode-map [menu-bar logbook logbook-close-logbook]
'("Close logbook" . logbook-close-logbook))
(define-key logbook-mode-map "\C-c\C-b" 'logbook-insert-bibtex-entries)
(define-key logbook-mode-map [menu-bar logbook logbook-insert-bibtex-entries]
'("Insert BibTeX entry" . logbook-insert-bibtex-entries))
(define-key logbook-mode-map "\C-c\C-d" 'logbook-archive-document)
(define-key logbook-mode-map [menu-bar logbook logbook-archive-document]
'("Archive document" . logbook-archive-document))
(define-key logbook-mode-map "\C-c\C-p" 'logbook-archive-graphical-document)
(define-key logbook-mode-map [menu-bar logbook logbook-archive-graphical-document]
'("Archive a Picture" . logbook-archive-graphical-document))
(define-key logbook-mode-map "\C-c\C-k" 'logbook-add-index-entry)
(define-key logbook-mode-map [menu-bar logbook logbook-add-index-entry]
'("Add entry to index" . logbook-add-index-entry))
(define-key logbook-mode-map "\C-c\C-r" 'logbook-add-backward-reference)
(define-key logbook-mode-map [menu-bar logbook logbook-add-backward-reference]
'("Add a reference" . logbook-add-backward-reference))
(define-key logbook-mode-map "\C-c\C-t" 'logbook-textual-text)
(define-key logbook-mode-map [menu-bar logbook logbook-textual-text]
'("Add unformatted text" . logbook-textual-text))
(define-key logbook-mode-map "\C-c\C-w" 'logbook-screen-dump)
(define-key logbook-mode-map [menu-bar logbook logbook-screen-dump]
'("Add a screen dump" . logbook-screen-dump))
;; And the keys which have special HTML meaning
(define-key logbook-mode-map "&" 'logbook-html-ampersand)
(define-key logbook-mode-map ">" 'logbook-html-greater-than)
(define-key logbook-mode-map "<" 'logbook-html-less-than)
;; Including the various HTML cookie thingies.
(define-key logbook-mode-map "\C-c\C-ft" 'logbook-html-insert-font-typewriter)
(define-key logbook-mode-map "\C-c\C-fs" 'logbook-html-insert-font-strong)
(define-key logbook-mode-map "\C-c\C-fe" 'logbook-html-insert-font-emphasize)
;; And the list thingies.
(define-key logbook-mode-map "\C-c\C-ls" 'logbook-html-list-start)
(define-key logbook-mode-map "\C-c\C-l\C-M" 'logbook-html-list-insert)
)
;;}}}
;;{{{ Syntax table
(defvar logbook-mode-syntax-table nil
"Syntax table used while in logbook mode.")
(if logbook-mode-syntax-table
() ; Do not change the table if it is already set up.
(setq logbook-mode-syntax-table (make-syntax-table))
(set-syntax-table logbook-mode-syntax-table)
;; Make ~ / . a "word constituent" so typical filenames will get
;; processed properly.
(modify-syntax-entry ?/ "w " logbook-mode-syntax-table)
(modify-syntax-entry ?. "w " logbook-mode-syntax-table)
(modify-syntax-entry ?~ "w " logbook-mode-syntax-table)
(modify-syntax-entry 43 "w " logbook-mode-syntax-table))
;;}}}
;;{{{ Internal variables
(defvar logbook-current-logbook-file nil
"File currently being worked on. Do not set this --
it is set automatically by logbook-open-logbook")
(defvar logbook-title-of-page nil
"Title of entry currently being worked on. Do not set this --
it is set automatically by logbook-open-logbook")
;(defvar logbook-entry-date nil
; "Date on which entry currently being worked on was created.
; Do not set this -- it is set automatically by logbook-open-logbook")
(defun logbook-entry-date ()
"Returns a string containing the current date in 1 jan 1900 format."
(concat
(string-to-int (substring (current-time-string) 8 10)) " "
(substring (current-time-string) 4 7) " "
(substring (current-time-string) 20)))
(defvar logbook-currently-locked nil
"Variable which keeps track of whether or not an entry is currently
worked on, to prevent multiple entries from being open at once.")
(defvar logbook-entry-has-keywords nil
"Variable which keeps track of whether or not an entry has has
a keyword entered in it.")
(defvar logbook-archive-document-string-start "(SAVE-DOCUMENT->"
"Start of string to place before a filename to be archived.")
(defvar logbook-archive-document-string-end "<-SAVE-DOCUMENT)"
"End of string to place before a filename to be archived.")
(defvar logbook-document-is-image-regexp "\\.ps$\\|\\.jpg$"
"Regexp matching filenames to be considered as images.")
(defvar logbook-index-string-start "(INDEX-KEYWORD->"
"Start of string to place before an index keywork to be archived.")
(defvar logbook-index-string-end "<-INDEX-KEYWORD)"
"Start of string to place after an index keywork to be archived.")
(defvar logbook-image-string-start "(IMAGE-DOCUMENT->"
"Start of string to place before an image to be inlined.")
(defvar logbook-image-string-end "<-IMAGE-DOCUMENT)"
"Start of string to place after an image to be inlined.")
(defvar logbook-textual-string-start "(TEXTUAL-STRING->"
"Start of string to place before text not to be messed up
by HTML.")
(defvar logbook-textual-string-end "<-TEXTUAL-STRING)"
"End of string to place after text not to be messed up
by HTML.")
(defvar logbook-backward-reference-string-start "(BACKWARD-REFERENCE->"
"Start of string to place before a link to a previous page.")
(defvar logbook-backward-reference-string-end "<-BACKWARD-REFERENCE)"
"Start of string to place after link to a previous page.")
(defvar logbook-thumbnail-size 128
"Size in pixels of inlined thumbnail images. Used by both ppmtops
and pstopnm to resize images.")
(defvar logbook-ppm-resize-args
(format " -xsize %d " logbook-thumbnail-size)
"Actual argument passed to pstopnm.")
(defvar logbook-object-type-alist
(list
(cons 'image-type
(list (cons logbook-image-string-start logbook-image-string-end)
'logbook-image-type-function))
(cons 'document-archive-type
(list (cons logbook-archive-document-string-start logbook-archive-document-string-end )
'logbook-document-archive-type-function))
(cons 'index-entry-type
(list (cons logbook-index-string-start logbook-index-string-end )
'logbook-index-entry-type-function))
(cons 'textual-string-type
(list (cons logbook-textual-string-start logbook-textual-string-end )
'logbook-textual-string-type-function))
(cons 'backward-reference-type
(list (cons logbook-backward-reference-string-start logbook-backward-reference-string-end )
'logbook-backward-reference-type-function)))
"Association list defining which delimiters and functions to call to
process each type of document.")
(defvar logbook-html-font-alist
(list
(list 'emphasize "" "")
(list 'strong "" "")
(list 'typewriter "" ""))
"Association list defining which pairs of HTML cookies to insert
for each type of argument to logbook-html-font")
(defvar logbook-title-page-alist nil
"Looks something like
((\"file1\" \"Title 1\" ) ; each file has one title
(\"file2\" \"Title 2\" )
(\"file3\" \"Title 3\" )))
Do not set this variable explicitly. It is automatically generated.")
(defvar logbook-reverse-title-page-alist nil
"Reverse of title-page-alist. Used to complete on things the user
is more likely to remember than file names.
Do not set this variable explicitly. It is automatically generated.")
(defvar logbook-file-to-keyword-alist nil
"Looks something like
((\"file1\" \"key1\" \"key2\" \"key3\") ; each file can have several keywords
(\"file2\" \"foo1\" \"key1\" \"foo3\")
(\"file3\" \"bar1\" \"foo1\" \"bar3\"))
Do not set this variable explicitly. It is automatically generated.")
(defvar logbook-keyword-to-file-alist nil
"Inverse of logbook-file-to-keyword-alist. Automatically generated.")
(defvar logbook-index-data-file ".logbook.eld"
"File in which to keep the index data.")
(defvar logbook-entry-header-string
"
%s
%s
"
"General format code to be inserted at the beginning of every log
entry. This sets logbook-archive-document-directory so entry can
be re-edited properly at a later time.")
(defvar logbook-entry-delimiter-string
"\n"
"String delimiting the body from the trailer. This is searched for
to decide where to insert the HTML pointer to the previous page.")
(defvar logbook-entry-trailer-string
"
Go back to the MAIN INDEX.
This page automatically created by %s
using the logbook.el emacs package version %s, courtesy of Alain Picard Page created on: %s
\n
"
"String to be inserted at the end of every log entry.")
(defvar logbook-index-header-string
"
Logbook index page.
Main Index
"
"String to insert at the start of the index file.")
(defvar logbook-index-trailer-string
(format
"Go back to the KEYWORD index.
This page was automatically generated by the
logbook-write-html-index function on %s.
Report any problems to
<ap@abelard.apana.org.au>.
" logbook-logbook-keyword-index (logbook-entry-date))
"String to insert at the end of the index file.")
(defvar logbook-keyword-index-header-string
"
Keyword Index
Index by keywords.
\n"
"String to insert at the start of the keyword index file.")
(defvar logbook-keyword-index-trailer-string
(format
"Go back to main index.
This page was automatically generated by the
logbook-write-html-keyword-index function on %s.
Report any problems to
<ap@abelard.apana.org.au>.
\n" logbook-logbook-index (logbook-entry-date))
"String to insert at the end of the keyword index file.")
;;}}}
;;{{{ User callable functions
(defun logbook-mode ()
" Provides functions to open entries in a logbook
and archive associated documents. Entries are written in HTML format
and images are inlined. Entries are categorized by titles and
keywords and written down in an index file.
Logbook mode automatically puts you in a narrowed buffer to hide
some HTML unpleasantness.
Special keybindings:
\\{logbook-mode-map}
Written by Alain Picard
http://www.fys.ruu.nl/~johnston/alain/"
(interactive)
(kill-all-local-variables)
(setq major-mode 'logbook-mode)
(setq mode-name "logbook")
(use-local-map logbook-mode-map)
(set-syntax-table logbook-mode-syntax-table)
(make-variable-buffer-local 'logbook-archive-document-directory)
(run-hooks 'logbook-mode-hook))
(defun logbook-open-logbook ()
" Main entry point for logbook-mode.
Opens a new logbook entry file, which should be
closed with the function logbook-close-logbook."
(interactive)
(if logbook-currently-locked
(error "A logbook entry is already being edited!"))
(let (start end)
(if (not (file-directory-p logbook-logbook-directory))
(error "logbook-logbook-directory must be an existing directory."))
(cd logbook-logbook-directory)
;; Set up some variables
(setq logbook-most-recent-file
(car (sort
(directory-files logbook-logbook-directory nil "[1-9]+.*html$")
'file-newer-than-file-p))
logbook-current-logbook-file (logbook-generate-new-filename)
logbook-currently-locked t
logbook-entry-has-keywords nil)
(remove-hook 'find-file-not-found-hooks 'insert-auto-insert-files)
(find-file (concat logbook-logbook-directory logbook-current-logbook-file))
;; This must be done AFTER the find-file, in order to be set
;; properly in the newly created buffer.
(setq logbook-archive-document-directory
(logbook-generate-daily-archive-directory))
(logbook-index-read-index-data)
;; Get the title
(while (or (equal logbook-title-of-page "") (eq logbook-title-of-page nil))
;; disallow empty titles
(setq logbook-title-of-page
(read-from-minibuffer "Title of page? ")))
(setq logbook-title-of-page ; Append the date
(concat logbook-title-of-page " --- " (logbook-entry-date)))
;; Add title to the index data structure
(setq logbook-title-page-alist
(logbook-add-entry-maybe-append
logbook-title-page-alist logbook-current-logbook-file logbook-title-of-page))
(setq logbook-reverse-title-page-alist
(logbook-add-entry-maybe-append
logbook-reverse-title-page-alist logbook-title-of-page logbook-current-logbook-file))
;; Set up the entry.
(insert (format logbook-entry-header-string
logbook-archive-document-directory
logbook-current-logbook-file
logbook-current-logbook-file
logbook-logbook-index logbook-title-of-page)
logbook-entry-delimiter-string
(format "Go to the previous logbook entry "
logbook-most-recent-file)
(format logbook-entry-trailer-string
logbook-logbook-index (user-full-name)
logbook-version (logbook-entry-date)))
(goto-char (point-min))
(setq start (re-search-forward "")) ; careful -- this
(setq start (re-search-backward "
")) ; careful -- this
(goto-char (point-max)) ; depends on exact form
(setq end (re-search-backward logbook-entry-delimiter-string)) ; logbook-entry-header-string
(narrow-to-region start end)
(logbook-mode)
(run-hooks 'logbook-insert-delimiter-hook)))
(defun logbook-close-logbook ()
" Closes a logbook file. This saves the LOGBOOK *buffer* to
logbook-logbook-directory with a unique filename, changes all
special logbook markers to HTML, and updates the index file."
;;
;; This is the main function of this mode.
;; When this routine is called, the following things happen:
;; - logbook-logbook-index is opened.
;; - the logbook-current-logbook-file is parsed.
;; - keywords and index entries are stored in index file.
;; - documents to be archived are stored in archive directory
;; - logbook-current-logbook-file is rewritten in HTML with
;; correct references to the saved documents and any other
;; links asked for.
(interactive)
(if (and logbook-entry-require-keywords
(not logbook-entry-has-keywords)
(not (y-or-n-p "No new keywords added -- close entry anyway?")))
(error "No keywords present -- unable to close logbook entry."))
(logbook-process-logbook-entry)
(save-buffer)
(logbook-index-save-index-data)
(kill-buffer nil)
(set-file-modes
(concat logbook-logbook-directory logbook-current-logbook-file)
256) ;make read only
(message "Updating the index files...")
(logbook-index-write-html-index)
(logbook-index-write-html-keyword-index)
(setq logbook-currently-locked nil
logbook-title-of-page nil) ; Important!!
(message "Done."))
(defun logbook-textual-text (start end)
"Prevents the region of text between point and mark from being
reformatted by HTML."
(interactive "r")
(let (string)
(setq string (buffer-substring start end))
(kill-region start end)
(logbook-insert-logbook-delimiter string 'textual-string-type)))
(defun logbook-add-index-entry ()
"Add a keyword or index entry in a logbook file"
(interactive)
(let (keyword)
(setq keyword
(completing-read "String to add to index? " logbook-keyword-to-file-alist))
(setq logbook-file-to-keyword-alist
(logbook-add-entry-maybe-append
logbook-file-to-keyword-alist logbook-current-logbook-file
keyword))
(setq logbook-keyword-to-file-alist
(logbook-add-entry-maybe-append
logbook-keyword-to-file-alist keyword logbook-current-logbook-file))
(logbook-insert-logbook-delimiter keyword 'index-entry-type))
(setq logbook-entry-has-keywords t))
(defun logbook-add-backward-reference ()
"Add a link to an existing logbook entry file"
(interactive)
(let (keyword)
(setq keyword
(completing-read "Page to reference? " logbook-reverse-title-page-alist))
(logbook-insert-logbook-delimiter keyword 'backward-reference-type)))
(defun logbook-archive-document (filename)
"Archive a document associated with a logbook entry."
(interactive "fFile to be archived? ")
(let (keyword)
(setq keyword
(expand-file-name filename))
(if (not (file-readable-p keyword))
(error "File was not readable.")
(logbook-insert-logbook-delimiter keyword 'document-archive-type))))
(defun logbook-archive-graphical-document (&optional filename)
"Archive a graphical document and inline it in the logbook entry."
(interactive "fImage file to be archived? ")
(let (keyword)
(setq keyword
(expand-file-name filename))
(if (not (file-readable-p keyword))
(error "File was not readable.")
(logbook-insert-logbook-delimiter keyword 'image-type))))
(defun logbook-archive-document-at-point ()
" Add necessary code to the logbook to archive the file under or
before point. Have you considered using logbook-archive-document
instead? It provides handy file completion."
(interactive)
(save-excursion
(backward-sexp)
(let ((start (point)) keyword)
(forward-sexp)
(setq keyword (buffer-substring start (point)))
(if (not (file-readable-p keyword))
(error "File was not readable.")
(progn
(kill-region start (point))
(logbook-insert-logbook-delimiter keyword 'document-archive-type))))))
(defun logbook-screen-dump ()
"Use xwd to dump the a screen window into a file, and
save to the appropriate directory."
(interactive)
(let (filename thumbnail basename ppm-file (start (point)))
(setq filename
(read-file-name "Name to store dump file into: "
logbook-temp-directory
"temp.gif")) ; Fix to a unique name
(if (not (string-match "\\.gif$" filename))
;; User didn't give us a gif extension -- so
(setq filename (concat filename ".gif")))
(ding)
(message "Click the mouse in the window you wish to dump:")
(call-process-region
start start
"/bin/sh" nil nil t "-c"
(concat
"xwd |"
logbook-pbmplus-directory
"xwdtopnm - |"
logbook-pbmplus-directory
"ppmtogif > "
(expand-file-name filename)))
(message "Screen dump complete.")
(logbook-archive-graphical-document filename)))
;;}}}
;;{{{ HTML keymap functions
;; This section keeps growing, 'cause all my users want more HTML
;; editing mode. I keep telling them this is not html-helper-mode. :-/
(defun logbook-html-ampersand ()
"Function to insert HTML ampersand"
(interactive)
(insert "&"))
(defun logbook-html-greater-than ()
"Function to insert HTML >"
(interactive)
(insert ">"))
(defun logbook-html-less-than ()
"Function to insert HTML <"
(interactive)
(insert "<"))
(defun logbook-html-list-start ()
"Function to start a new HTML unordered list. "
(interactive)
(insert "
\n")
(save-excursion
(insert "\n
"))
(logbook-html-list-insert))
(defun logbook-html-list-insert ()
"Function to add an item to an HTML unordered list. "
(interactive)
(insert "\t
"))
(defun logbook-html-insert-font-typewriter (arg)
"Set the region in HTML typewriter font. With prefix arg, wrap the
region in typewriter font."
(interactive "P")
(logbook-html-insert-font 'typewriter arg))
(defun logbook-html-insert-font-strong (arg)
"Set the region in HTML strong font."
(interactive "P")
(logbook-html-insert-font 'strong arg))
(defun logbook-html-insert-font-emphasize (arg)
"Set the region in HTML emphasize font."
(interactive "P")
(logbook-html-insert-font 'emphasize arg))
(defun logbook-html-insert-font (type wrap)
"Insert the font specified by type. Wrap around point and mark
if wrap is non nil."
(let ((cur)
(header (nth 0 (cdr (assoc type logbook-html-font-alist))))
(trailer (nth 1 (cdr (assoc type logbook-html-font-alist))))
(string))
(if wrap
(progn
(setq string (buffer-substring (point) (mark)))
(kill-region (point) (mark)))
(setq string ""))
(insert header string)
(save-excursion
(insert trailer))
(run-hooks 'logbook-insert-delimiter-hook)))
;;}}}
;;{{{ Internal functions
(defun logbook-process-logbook-entry ()
"Replace all logbook specific delimiters with HTML delimiters.
Replace multiple blank lines with a
separator.
Copy all documents to be archived to the daily archive directory."
(save-excursion
;; First the paragraphs: replace any line or block of lines
;; consisting only of whitespace characters by a paragraph marker.
(goto-char (point-min))
(replace-regexp "^\\s-*$" "
")
(let ((i 0) filename-or-string start end B1 B2 B3 E1 E2 E3)
(while (nth i logbook-object-type-alist)
(message "Processing entries of type %s..."(prin1(car (nth i logbook-object-type-alist))))
(setq start (car (car (cdr (nth i logbook-object-type-alist)))))
(setq end (cdr (car (cdr (nth i logbook-object-type-alist)))))
(goto-char (point-min))
(while (re-search-forward start (point-max) t)
(setq B1 (match-beginning 0))
(setq E1 (match-end 0))
(re-search-forward end (point-max) t)
(setq B3 (match-beginning 0))
(setq E3 (match-end 0))
(setq filename-or-string (buffer-substring E1 B3))
(delete-region B1 E3)
(funcall (nth 2 (nth i logbook-object-type-alist)) filename-or-string))
(setq i (+ 1 i))))))
(defun logbook-copy-document (filename)
"Copy the filename to the archive directory, and return
the new destination, relative to the logbook-logbook-directory,
if successful."
(let (destination)
(setq destination
(concat logbook-archive-document-directory
(file-name-nondirectory filename)))
;do the copying
(if (file-readable-p filename)
(copy-file filename (expand-file-name destination) 1 t) ; asks user to confirm overwrite
(progn ; Serious problem!
(message "So such file %s to be saved!" filename)
(setq destination nil)))
(if logbook-always-archive
(if (not (string-match logbook-dont-archive-regexp destination))
(setq destination (logbook-compress-document destination))))
destination))
(defun logbook-compress-document (filename)
"Run gzip on a filename, and return the name of the compressed file.
If the compression is not successful, nil is returned."
;; does nothing for now
(let (start)
(if (not (eq 0
(call-process-region
start start
"/bin/sh" nil nil t "-c"
(concat
"gzip --quiet --best "
filename))))
nil
(concat filename ".gz"))))
(defun logbook-insert-logbook-delimiter (string document-type)
"Inserts the appropriate bracketing delimiters around string
in the logbook buffer."
(save-excursion
(insert
(car (car (cdr (assq document-type logbook-object-type-alist))))
string
(cdr (car (cdr (assq document-type logbook-object-type-alist)))))
(run-hooks 'logbook-insert-delimiter-hook)))
(defun logbook-make-thumbnail (filename)
"Convert the file into a gif image, and return a
string which is the filename of the thumbnail. If thumbnail cannot
be made, nil is returned. At present, this only recognizes
Postscript and gif images."
(let (thumbnail basename ppm-file (start (point)))
(cond
((string-match "\\.ps$" filename) ; Postscript files
(setq ppm-file (logbook-convert-postscript-to-pnm filename)))
((string-match "\\.gif$" filename) ; GIF files
(setq ppm-file (logbook-convert-gif-to-pnm filename))))
(if ppm-file
;; OK. now we have the .ppm file. Now convert it to gif:
(progn
(setq basename (substring
filename
0 (string-match "\\..*$" filename)))
(setq thumbnail (expand-file-name (concat basename "-thumbnail.gif")))
(call-process-region
start start
"/bin/sh" nil nil t "-c"
(concat
logbook-pbmplus-directory
"ppmquant -floyd 8 " ppm-file "|"
logbook-pbmplus-directory
"ppmtogif" " - " " > " thumbnail))
;; get rid of ppm file and put the thumbnail somewhere innocuous:
(delete-file ppm-file)
thumbnail)
(progn
(message "Unable make a thumbnail -- skipping.")
nil))))
(defun logbook-convert-postscript-to-pnm (filename)
"Run pstopnm on a file. Returns the absolute path name of the pnm file."
(let (start basename)
(setq basename (substring (file-name-nondirectory filename) 0 -3))
(if (eq 0
(call-process-region
start start
"/bin/sh" nil nil t "-c"
(concat
logbook-pbmplus-directory
"pstopnm "
logbook-ppm-resize-args
" " ;space, just in case
(expand-file-name filename))))
;; It is highly inconvenient that this program creates files called
;; file001.ppm from input files file.ps. So we must figure
;; out what the file will be called and rename it to
;; something unique, so it does not get clobbered the next
;; time the logbook-mode-thumbnail is called.
(expand-file-name (concat basename "001.ppm"))
nil))) ;; pstopnm failed
(defun logbook-convert-gif-to-pnm (filename)
"Run giftopnm on a file. Returns the absolute path name of the pnm file."
(let (start basename)
(setq basename (substring (file-name-nondirectory filename) 0 -4))
(setq ppm-file (expand-file-name (concat basename "001.ppm")))
(if (eq 0
(call-process-region
start start
"/bin/sh" nil nil t "-c"
(concat
logbook-pbmplus-directory
"giftopnm "
filename " |"
logbook-pbmplus-directory
"pnmscale "
logbook-ppm-resize-args
" - >" ; space, just in case
ppm-file)))
(expand-file-name ppm-file)
nil))) ; giftopnm failed
(defun logbook-insert-bibtex-entries ()
"Insert an html citation tag entry.
If point is at the beginning or in the middle of a word, use
that word as the key, otherwise, prompt."
(interactive)
(let ((key (logbook-get-current-word-and-kill)))
(if (not key)
(setq key (read-from-minibuffer "BibTeX key to use?")))
(insert (format "\\cite{%s}"
key key))))
(defun logbook-get-current-word-and-kill ()
(let ((word (current-word t)))
(if word
;; kill it. we may need to back up:
(progn
(if (not (looking-at word)) (forward-word -1))
(kill-word 1)))
word))
;;}}}
;;{{{ alist-function definitions
(defun logbook-document-archive-type-function (filename)
"Process a file of type document-archive-type. This
saves the file to the archive directory and inserts an
html link in the logbook-entry buffer."
(save-excursion
(let (destination)
(setq destination (logbook-copy-document filename))
(if destination
(insert (format "%s" destination destination))))))
(defun logbook-image-type-function (filename)
"Process a file of type image-type. This
saves the file to the archive directory, creates a thumbnail image,
and inserts an html link for this thumbnail to the original image
file in the logbook-entry buffer."
(save-excursion
(let (destination thumbnail thumbnail-copy)
;; First copy the original postscript to safety.
(setq destination (logbook-copy-document filename))
(if destination
(progn
;; Next, make a thumbnail sketch
(setq thumbnail (logbook-make-thumbnail filename))
(if thumbnail
(progn
;; Copy *it* to safety;
(setq thumbnail-copy (logbook-copy-document thumbnail))
;; Get rid of the old thumbnail
(delete-file thumbnail)
;; Insert a clickable thumbnail: clicking it goes to source file.
(insert (format ""
destination thumbnail-copy))))
(message "Unable to process file %s, skipping..." filename))))))
(defun logbook-index-entry-type-function (string)
"Process a string of type index-entry-type. This
saves the file to the archive directory and inserts an
html link in the logbook-entry buffer."
(save-excursion
(insert (format "
Keywords: %s
"
string string))))
(defun logbook-textual-string-type-function (string)
"Process a file of type textual-string-type. This
merely puts in some html delimiters to prevent text wrap."
(save-excursion
(insert (format "
\n%s\n
" string))))
(defun logbook-backward-reference-type-function (title-string)
"Insert an html link to the page referenced to by the title-string."
(save-excursion
(insert (format " Jump to page: %s "
(car (cdr (assoc title-string logbook-reverse-title-page-alist)))
title-string))))
;;}}}
;;{{{ generate-directory, generate-new-filename
(defun logbook-generate-daily-archive-directory ()
"Create a directory based on date in which to put all
documents to be saved during that day. and set the
variable logbook-archive-document-directory to point to it."
(let (filename month day year)
(setq year (substring (current-time-string) 20))
(setq month (substring (current-time-string) 4 7))
(setq day (string-to-int (substring (current-time-string) 8 10)))
(setq filename
(concat year "-" month "-" day "/"))
(make-directory
(concat logbook-logbook-directory
filename) t)
filename))
(defun logbook-generate-new-filename ()
"Returns a unique filename for the current date."
(let (filename month day year (filenumber 0))
(setq year (substring (current-time-string) 20))
(setq month (substring (current-time-string) 4 7))
(setq day (string-to-int (substring (current-time-string) 8 10)))
(while (file-exists-p
(concat logbook-logbook-directory
(setq filename (concat
year "-" month "-" day "-" filenumber ".html"))))
(setq filenumber (+ 1 filenumber)))
filename))
;;}}}
;;{{{ Index maintenance and generation.
;;; Functions in this section are used to maintain the logbook index.
;;; This is done by keeping certain lisp variables up to date, namely:
;;; logbook-title-page-alist -- keeps the title pages
;;; logbook-file-to-keyword-alist -- keeps the keywords referenced
;;; in each logbook-entry file
;;; logbook-keyword-to-file-alist -- inverse of above, automatically
;;; generated (used for prompting for
;;; keywords, as author is likely to
;;; want to reuse keywords
;;;
;;; Important functions:
;;; logbook-add-entry-maybe-append -- used to add entries to the
;;; various alists.
;;;
;;; Random comments
;; These two alists can be rebuilt from the logbook-entry-files on demand. then:
;; (setq logbook-list-of-files (mapcar 'car logbook-keyword-alist))
;; is mighty convenient.
;; Automatically generate the keyword-to-file list:
;; (setq logbook-keyword-to-file-alist
;; (reverse-assoc-list logbook-file-to-keyword-alist))
;; (setq logbook-list-of-known-keys (mapcar 'car logbook-keyword-to-file-alist))
;; Which can be used to prompt user when inserting new keywords, and
;; to keep track of which files should be linked by keyword in index, etc.
;; (completing-read "prompt" logbook-keyword-to-file-alist)
;;
;; (pretty-print-list logbook-keyword-alist)
;; (pretty-print-list (reverse-assoc-list logbook-keyword-alist))
;;
;; (defun logbook-file-entry (file alist)
;; (cdr (assoc file alist)))
;; (logbook-file-entry "file2" logbook-keyword-alist)
(defun logbook-index-rebuild-index ()
"Re-create the logbook index structure by parsing all the logbook
entry files in logbook-logbook-directory. Normally, there is
no need to call this, as the index file structure is kept up to date after
each invocation of logbook-close-logbook and saved in .logbook.eld,
but if an accident happens, this function comes in handy."
(interactive)
(save-excursion
;; Reset the alists to nil
(setq logbook-file-to-keyword-alist nil
logbook-keyword-to-file-alist nil
logbook-title-page-alist nil
logbook-reverse-title-page-alist nil)
(let (entries)
(cd logbook-logbook-directory)
(setq entries
(mapcar (lambda (x) (file-relative-name
(concat logbook-logbook-directory x)))
(reverse (sort
(directory-files
logbook-logbook-directory nil
"^[1-9]+\\(.*html\\)?$")
'logbook-filename-earlier-p))))
(while entries
(message (format "Processing %s..." entries))
(logbook-index-process-entry (car entries))
(setq entries (cdr entries))))
(setq logbook-keyword-to-file-alist
(logbook-reverse-assoc-list logbook-file-to-keyword-alist))
(setq logbook-reverse-title-page-alist
(logbook-reverse-assoc-list logbook-title-page-alist))
(logbook-index-save-index-data)
(logbook-index-write-html-index)
(logbook-index-write-html-keyword-index))) ; Write out the new index
(defun logbook-index-process-entry (logbook-entry)
" Parse a logbook-entry."
(cond ((file-directory-p logbook-entry)
(logbook-index-process-entry-directory logbook-entry))
((file-regular-p logbook-entry)
(logbook-index-process-entry-file logbook-entry))
(t
(error "unrecognized file type %s in directory %s"
logbook-entry
(pwd)))))
(defun logbook-index-process-entry-directory (logbook-entry)
" Creates link to a directory containing logbook-entry files."
;; logbook-entry is the name of a directory like "1997", and
;; it contains an index file logbook-logbook-index
(let ((logbook-index-entry (concat logbook-entry "/" logbook-logbook-index)))
(setq logbook-title-page-alist
(logbook-add-entry-maybe-append
logbook-title-page-alist logbook-index-entry
(concat "Index for the year " logbook-entry)))
(setq logbook-reverse-title-page-alist
(logbook-add-entry-maybe-append
logbook-reverse-title-page-alist
(concat "Index for the year " logbook-entry)
logbook-index-entry))))
(defun logbook-index-process-entry-file (logbook-entry)
" Parse a logbook-entry, looking for keywords and titles, and add to the
index data structure."
(let (keywords buf)
(save-excursion
(setq buf (find-file-read-only logbook-entry))
(switch-to-buffer buf)
(goto-char (point-min)) ; look for keywords
(while
(re-search-forward "
Keywords: \\(.*\\)
" (point-max) t)
(setq keywords (buffer-substring (match-beginning 1) (match-end 1)))
(message (format "Found keyword %s..." keywords))
(setq logbook-file-to-keyword-alist
(logbook-add-entry-maybe-append
logbook-file-to-keyword-alist logbook-entry keywords)))
(goto-char (point-min)) ; look for title of pages
(while
;; ok. this is tricky. Gobble trailing spaces. This is bad,
;; because it prevents us from using
for anything else.
;; hmmm.
(re-search-forward "
\\(.*\\)\\b\\s-*
" (point-max) t)
(setq keywords (buffer-substring (match-beginning 1) (match-end 1)))
(message (format "Found title %s..." keywords))
(setq logbook-title-page-alist
(logbook-add-entry-maybe-append
logbook-title-page-alist logbook-entry keywords))
(setq logbook-reverse-title-page-alist
(logbook-add-entry-maybe-append
logbook-reverse-title-page-alist keywords logbook-entry)))
(kill-buffer buf))))
(defun logbook-index-write-html-index ()
"Write out an HTML index file from the current index structure."
(save-excursion
(let (buf (entries (mapcar 'car logbook-title-page-alist)))
(cd logbook-logbook-directory)
(if (file-exists-p logbook-logbook-index)
(delete-file logbook-logbook-index))
(setq buf (find-file logbook-logbook-index))
(switch-to-buffer buf)
(insert logbook-index-header-string)
(insert "
"
(car entries)
(nth 1 (assoc (car entries) logbook-title-page-alist))))
(let ((i 1))
(while (nth i (assoc (car entries) logbook-file-to-keyword-alist))
(insert
(format " %s, "
(car entries)
(nth i (assoc (car entries) logbook-file-to-keyword-alist))))
(backward-delete-char 1) ; Get rid of last comma
(setq i (+ i 1))))
(setq entries (cdr entries)))
(insert "\n
\n")
(insert logbook-index-trailer-string)
(save-buffer buf)
(kill-buffer buf))))
(defun logbook-index-write-html-keyword-index ()
"Write out an HTML index file for the keywords from the current
index structure."
(save-excursion
(let (buf (entries (sort (mapcar 'car logbook-keyword-to-file-alist) 'string<)))
(cd logbook-logbook-directory)
(if (file-exists-p logbook-logbook-keyword-index)
(delete-file logbook-logbook-keyword-index))
(setq buf (find-file logbook-logbook-keyword-index))
(switch-to-buffer buf)
(insert logbook-keyword-index-header-string)
(insert "