;;; Memo
;;; $Id$
;;; Specifically, an emacs mode for playing with Pilot memos as backed
;;; up by PilotManager and the SyncMemo conduit.
;;; Waider 2000/2001

(defvar pm-memo-dir (expand-file-name "~/.pilotmgr/SyncMemo")
  "* directory where PilotManager keeps memos.")

(defvar pm-memo-categories nil
  "* list of memo categories")

(defvar pm-memo-memos nil
  "* list of memos, in the form ( CATEGORY ( TITLE . FILENAME ))")

(defvar pm-memo-max-size 4096
  "maximum size of a memo, pilot-restricted")

(defvar pm-memo-selected-category nil)

(defun pm-memopad()
  "A Simple Memo Pad"
  (interactive)

  ;; get categories
  (setq pm-memo-categories (pm-memo-get-categories))

  ;; get list of memos per category
  (setq pm-memo-memos (pm-memo-get-memos pm-memo-categories))

  ;; display all memos
  (pm-memo-display-memos pm-memo-memos)

  (display-buffer "Memo Index")
  (set-buffer "Memo Index")
  (goto-char (point-min))
  (pm-memo-index-mode)
  )

(defun pm-memo-get-categories()
  "Get a list of categories from the memo directory"

  ;; This doesn't get categories that are empty. probably a bug.

  ;; Die instantly if pm-memo-dir is unset.
  (if (not (file-directory-p pm-memo-dir))
      (error "pm-memo-dir is not a directory!"))

  ;; Read the directory. Any subdirectories are categories.
  (delq nil (mapcar '(lambda(f)
                       (if (file-directory-p
                            (concat pm-memo-dir "/" f))
                           (if (string-match "^\\.\\.?" f)
                               nil
                             f)
                         nil))
                    (directory-files pm-memo-dir))))


(defun pm-memo-get-memos( category-list )
  "Get a list of memos"
  (if (stringp category-list)
      (setq category-list (list category-list)))
  (mapcar
   '(lambda(c)
      (cons c (mapcar '(lambda(m) (cons (pm-memo-get-memo-title c m) m))
                      (pm-memo-get-category-memos c))))
   category-list))

(defun pm-memo-get-category-memos( category )
  "Get a list of memos in the specified category"
  (delq nil (mapcar '(lambda(f)
                       (if (file-regular-p
                            (concat pm-memo-dir "/" category "/" f))
                           (if (string-match "^\\.\\.?" f)
                               nil
                             f)
                         nil))
                    (directory-files (concat pm-memo-dir "/" category)))))

(defun pm-memo-get-memo-title( category filename )
  "Get the first line from the specified memo.

Loads all memos as a side effect. Urgh."

  (let ((realfilename (concat pm-memo-dir "/" category "/" filename)))

    ;; throw if not a real file
    (if (not (file-regular-p realfilename))
        (error "%s: not a regular file" realfilename))

    ;; throw if unreadable
    (if (not (file-readable-p realfilename))
        (error "%s: not a readable file" realfilename))

    ;; grab the first line of the file
    ;; blargh. We actually need to pull in the file for this.
    ;; may as well make that a 'feature'

    ;; FIXME make this smarter - don't read unless we have to, offer
    ;; revert/merge options in case there's been a hotsync since last
    ;; time we looked, set buffer to memo-mode whatever that is, etc.
    (save-excursion
      (set-buffer (get-buffer-create
                   (concat " *Memo - " category " - " filename)))
      (erase-buffer)
      (insert-file-contents realfilename)
      (setq buffer-file-name realfilename)
      (set-buffer-modified-p nil)
      (goto-char (point-min))
      (end-of-line)
      (buffer-substring (point-min) (point)))))

(defun pm-memo-display-memos( memos &optional category )
  "Display an index of MEMOS, optionally filtering by CATEGORY"
  (save-excursion
    (set-buffer (get-buffer-create "Memo Index"))
    (erase-buffer) ;; could we be smarter? could we care less?

    ;; Whee!
    ;; er, redunant code, really. must consolidate.
    ;; We need to find a way to tie all this crap to actual files, mind.
    (setq pm-memo-selected-category category)
    (let ((memos
           (if category
               (delete nil
                       (mapcar
                        (function
                         (lambda(ml)
                           (if (string= (car ml) category) ml)))
                        memos))
             memos))
          (num 0))
      (insert
       (mapconcat
        '(lambda( c )
           (let ((ml (cdr c)))
             (mapconcat '(lambda(m)
                           (setq num (+ 1 num))
                           (format "%2d. %s" num (car m)))
                        ml "\n"))) memos "\n")))))

(defvar pm-memo-mode-map () "Keymap used in Pilot Memos")
(defvar pm-memo-index-mode-map () "Keymap used in Pilot Memo Index")
;; (setq pm-memo-mode-map nil pm-memo-index-mode-map nil)  ;; debug

;; Bork bork bork. Rather gross.
(defun pm-memo-category-function( c )
  (let* ((funame (intern (format "pm-memo-%s-category" c)))
         (code (list 'defun funame (list)
                     (list 'interactive)
                     (list 'pm-memo-category c))))
    (eval code)))

(if pm-memo-mode-map nil
  (setq pm-memo-mode-map (make-keymap))
  ;; insert more keydefs here.
  ;; 1. Menus:
  ;;    Record      Edit           Options              Category V
  ;;    ----------------------------------
  ;;    New Memo    Undo           Font
  ;;    Delete Memo Cut            Go to Top of Page
  ;;    [Beam Memo] Copy           Go to Bottom of Page
  ;;                Paste          Phone Lookup
  ;;                Select All     About Memo Pad
  ;;                ----------
  ;;                Keyboard
  ;;                Graffitit Help
  ;;
  ;; 2. Bottom line
  ;;    [Done] [Details]
  ;;    Done -> back to memo list
  ;;    Details -> Category V, Private, OK, Cancel, Delete
  ;;    Delete -> [] Save Archive copy, OK, Cancel

  ;; FIXME xemacs?
  ;; Menus have to be built bass-ackwards, apparently.
  (let ((rmap (make-sparse-keymap))
        (omap (make-sparse-keymap))
        (cmap (make-sparse-keymap)))

    (define-key pm-memo-mode-map [menu-bar] (make-sparse-keymap))

    ;; Categories menu
    (define-key pm-memo-mode-map [menu-bar Category] (cons "Category"
                                                           cmap))
    (define-key cmap [edit-category] '("Edit Categories..."
                                       . pm-memo-edit-categories))

    ;; The rest of the list is the category list, reverse-sorted
    ;; alphabetically.
    (mapcar (function (lambda( c )
                        ;; menu function
                        (pm-memo-category-function c)

                        ;; menu entry
                        (define-key cmap
                          (vector (intern (format "%s-category" c)))
                          (cons (format "%s" c)
                                (intern (format "pm-memo-%s-category" c))))))

            ;; sillywalk Unfiled into the right place
            (append (list "Unfiled") (reverse (delete "Unfiled"
                                     (pm-memo-get-categories)))))

    ;; Options menu
    (define-key pm-memo-mode-map [menu-bar Options] (cons "Options"
                                                          omap))
    (define-key omap [about] '("About Memo Pad" . pm-memo-about))
    (define-key omap [lookup] '("Phone Lookup"
                                . pm-memo-phone-lookup))
    (define-key omap [bottom] '("Go to Bottom of Page" . end-of-buffer))
    (define-key omap [top] '("Go to Top of Page"
                             . beginning-of-buffer))
    (define-key omap [font] '("Font" . pm-memo-font))

    ;; Record menu
    (define-key pm-memo-mode-map [menu-bar Record] (cons "Record"
                                                         rmap))
    (define-key rmap [beam-memo] '("Beam Memo" . pm-memo-beam-memo))
    (define-key rmap [del-memo] '("Delete Memo" . pm-memo-delete-memo))
    (define-key rmap [new-memo] '("New Memo" . pm-memo-new-memo))
    ))

(defun pm-memo-index-insert(n)
  (interactive "p")
  (set-buffer (get-buffer-create " *New Memo*"))
  (self-insert-command n))

(if pm-memo-index-mode-map nil
  ;; I could probably do a far better job of this.
  (setq pm-memo-index-mode-map (copy-keymap pm-memo-mode-map))

  ;; All Categories
  (define-key-after (lookup-key pm-memo-index-mode-map [menu-bar Category])
    [all-cateory] '("All" . pm-memo-category) nil)
  (pm-memo-category-function "All")

  ;; Other things: Record menu should be "Beam Category" only.
  ;; Options should be Font, Preferences, About.
  ;; Preferences is sort-by: alpha or "manual"?

  ;; Fetch current memo
  (define-key pm-memo-index-mode-map [return]
    '("Fetch Memo" . pm-get-memo-at-point))

  ;; Clear out key definitions for everything else.
  (substitute-key-definition 'self-insert-command
                             'pm-memo-index-insert
                             pm-memo-index-mode-map
                             global-map))

(defun pm-memo-mode()
  "Major mode for handling Pilot Memos
And that's all the doco you're getting for now."
  (interactive)
  (kill-all-local-variables)
  (use-local-map pm-memo-mode-map)
  (setq major-mode 'pm-memo-mode)
  (setq mode-name "Memo")
  )

(defun pm-memo-index-mode()
  "Major mode for handling Pilot Memos
And that's all the doco you're getting for now."
  (interactive)
  (kill-all-local-variables)
  (use-local-map pm-memo-index-mode-map)
  (setq major-mode 'pm-memo-index-mode)
  (setq mode-name "Memo-Index")
  )

(defun pm-memo-delete-memo()
  "Delete a memo. And its little doggy, too."
  (interactive)

  ;; Delete only if we're in a memo, thanks.
  (if (not (eq major-mode 'pm-memo-mode))
      (error "Not reading a memo!"))

  ;; Are you sure?
  (if (y-or-n-p "Delete this memo?")
      ;; get the filename of the buffer and NUKE NUKE NUKE
      (let ((killme buffer-file-name))
        (if (not killme)
            (error "%s doesn't appear to have an associated file!"
                   (buffer-name))
          (if (kill-buffer (current-buffer))
              (delete-file killme)
            (error "Delete cancelled."))))
    (error "Delete cancelled.")))

(defun pm-memo-category( &optional category )
  (interactive)
  (pm-memo-display-memos pm-memo-memos category)
  (setq pm-memo-selected-category category))

;; could do this with overlays/extents
;; if I want to go through that hell again, of course.
(defun pm-get-memo-at-point()
  (interactive)
  (let* ((memos (pm-memo-get-memos (or pm-memo-selected-category
                                       pm-memo-categories)))
         (current-point (point))
         (current-category (car memos))
         (memos (cdr memos))
         (current-memo (car (cdr current-category))))

    (save-excursion
      (goto-char (point-min))
      (while (>= current-point (point))
        (if (null (cdr current-category))
          (setq current-category (car memos)
                memos (cdr memos)))
        (setq current-memo (car (cdr current-category)))
        (setcdr current-category (cdr (cdr current-category)))
        (forward-line 1)))
    (message (format " *Memo - %s - %s" (car current-category)
                        (cdr current-memo)))
    (display-buffer (format " *Memo - %s - %s" (car current-category)
                            (cdr current-memo)))
    ))