contrib/lisp/org2rem.el

   1 ;;; org2rem.el --- Convert org appointments into reminders
   2
   3 ;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc.
   4
   5 ;; Author: Bastien Guerry and Shatad Pratap
   6 ;; Keywords: outlines, hypermedia, calendar, wp
   7 ;; Homepage: http://orgmode.org
   8 ;; Version: 6.09a
   9 ;;
  10 ;; This file is not part of GNU Emacs.
  11 ;;
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  24 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  25 ;;
  26 ;;; Commentary:
  27
  28 ;; (require 'org2rem)
  29 ;; To export, do
  30 ;;
  31 ;;    M-x org2rem-combine-agenda-files
  32 ;;
  33 ;; Then you can use reming like this:
  34 ;;
  35 ;;  $ remind ~/org.rem
  36 ;;
  37 ;; If you want to use this regualrly, try in .emacs
  38 ;;
  39 ;;    (add-hook 'org-mode-hook
  40 ;;       (lambda() (add-hook 'after-save-hook
  41 ;;                 'org-export-remind-all-agenda-files t t)))
  42
  43 (require 'org)
  44 (require 'org-agenda)
  45 (require 'org-exp)
  46 (eval-and-compile
  47   (require 'cl))
  48
  49 (defgroup org2rem nil
  50   "Options specific for Remind export of Org-mode files."
  51   :tag "Org Export Remind"
  52   :group 'org-export)
  53
  54 (defcustom org-combined-agenda-remind-file "~/org.rem"
  55   "The file name for the Remind file covering all agenda files.
  56 This file is created with the command \\[org2rem-all-agenda-files].
  57 The file name should be absolute, the file will be overwritten without warning."
  58   :group 'org2rem
  59   :type 'file)
  60
  61 (defcustom org-remind-combined-name "OrgMode"
  62   "Calendar name for the combined Remind representing all agenda files."
  63   :group 'org2rem
  64   :type 'string)
  65
  66 (defcustom org-remind-use-deadline '(event-if-not-todo todo-due)
  67   "Contexts where Remind export should use a deadline time stamp.
  68 This is a list with several symbols in it.  Valid symbol are:
  69
  70 event-if-todo       Deadlines in TODO entries become calendar events.
  71 event-if-not-todo   Deadlines in non-TODO entries become calendar events.
  72 todo-due            Use deadlines in TODO entries as due-dates"
  73   :group 'org2rem
  74   :type '(set :greedy t
  75               (const :tag "Deadlines in non-TODO entries become events"
  76                      event-if-not-todo)
  77               (const :tag "Deadline in TODO entries become events"
  78                      event-if-todo)
  79               (const :tag "Deadlines in TODO entries become due-dates"
  80                      todo-due)))
  81
  82 (defcustom org-remind-use-scheduled '(todo-start)
  83   "Contexts where Remind export should use a scheduling time stamp.
  84 This is a list with several symbols in it.  Valid symbol are:
  85
  86 event-if-todo       Scheduling time stamps in TODO entries become an event.
  87 event-if-not-todo   Scheduling time stamps in non-TODO entries become an event.
  88 todo-start          Scheduling time stamps in TODO entries become start date.
  89                     Some calendar applications show TODO entries only after
  90                     that date."
  91   :group 'org2rem
  92   :type '(set :greedy t
  93               (const :tag
  94                      "SCHEDULED timestamps in non-TODO entries become events"
  95                      event-if-not-todo)
  96               (const :tag "SCHEDULED timestamps in TODO entries become events"
  97                      event-if-todo)
  98               (const :tag "SCHEDULED in TODO entries become start date"
  99                      todo-start)))
 100
 101 (defcustom org-remind-categories '(local-tags category)
 102   "Items that should be entered into the categories field.
 103 This is a list of symbols, the following are valid:
 104
 105 category    The Org-mode category of the current file or tree
 106 todo-state  The todo state, if any
 107 local-tags  The tags, defined in the current line
 108 all-tags    All tags, including inherited ones."
 109   :group 'org2rem
 110   :type '(repeat
 111           (choice
 112            (const :tag "The file or tree category" category)
 113            (const :tag "The TODO state" todo-state)
 114            (const :tag "Tags defined in current line" local-tags)
 115            (const :tag "All tags, including inherited ones" all-tags))))
 116
 117 (defcustom org-remind-include-todo nil
 118   "Non-nil means export to remind files should also cover TODO items."
 119   :group 'org2rem
 120   :type '(choice
 121           (const :tag "None" nil)
 122           (const :tag "Unfinished" t)
 123           (const :tag "All" all)))
 124
 125 (defcustom org-remind-include-sexps t
 126   "Non-nil means export to Remind files should also cover sexp entries.
 127 These are entries like in the diary, but directly in an Org-mode file."
 128   :group 'org2rem
 129   :type 'boolean)
 130
 131 (defcustom org-remind-deadline-over-scheduled t
 132   "Non-nil means use deadline as target when both deadline and
 133 scheduled present, vice-versa. Default is Non-nil."
 134   :group 'org2rem
 135   :type 'boolean)
 136
 137 (defcustom org-remind-escape-percentage t
 138   "Non-nil means % will be escaped, vice-versa. Default is Non-nil."
 139   :group 'org2rem
 140   :type 'boolean)
 141
 142 (defcustom org-remind-extra-warn-days 3
 143   "Extra days Remind keep reminding."
 144   :group 'org2rem
 145   :type 'number)
 146
 147 (defcustom org-remind-advanced-warn-days 3
 148   "Advanced days Remind start reminding."
 149   :group 'org2rem
 150   :type 'number)
 151
 152 (defcustom org-remind-suppress-last-newline nil
 153   "Non-nil means suppress last newline REM body. Default is nil."
 154   :group 'org2rem
 155   :type 'boolean)
 156
 157 (defcustom org-remind-include-body 100
 158   "Amount of text below headline to be included in Remind export.
 159 This is a number of characters that should maximally be included.
 160 Properties, scheduling and clocking lines will always be removed.
 161 The text will be inserted into the DESCRIPTION field."
 162   :group 'org2rem
 163   :type '(choice
 164           (const :tag "Nothing" nil)
 165           (const :tag "Everything" t)
 166           (integer :tag "Max characters")))
 167
 168 (defcustom org-remind-store-UID nil
 169   "Non-nil means store any created UIDs in properties.
 170 The Remind standard requires that all entries have a unique identifyer.
 171 Org will create these identifiers as needed.  When this variable is non-nil,
 172 the created UIDs will be stored in the ID property of the entry.  Then the
 173 next time this entry is exported, it will be exported with the same UID,
 174 superceeding the previous form of it.  This is essential for
 175 synchronization services.
 176 This variable is not turned on by default because we want to avoid creating
 177 a property drawer in every entry if people are only playing with this feature,
 178 or if they are only using it locally."
 179   :group 'org2rem
 180   :type 'boolean)
 181
 182 ;;;; Exporting
 183
 184 ;;; Remind export
 185
 186 ;;;###autoload
 187 (defun org2rem-this-file ()
 188   "Export current file as an Remind file.
 189 The Remind file will be located in the same directory as the Org-mode
 190 file, but with extension `.rem'."
 191   (interactive)
 192   (org2rem nil buffer-file-name))
 193
 194 ;;;###autoload
 195 (defun org2rem-all-agenda-files ()
 196   "Export all files in `org-agenda-files' to Remind .rem files.
 197 Each Remind file will be located in the same directory as the Org-mode
 198 file, but with extension `.rem'."
 199   (interactive)
 200   (apply 'org2rem nil (org-agenda-files t)))
 201
 202 ;;;###autoload
 203 (defun org2rem-combine-agenda-files ()
 204   "Export all files in `org-agenda-files' to a single combined Remind file.
 205 The file is stored under the name `org-combined-agenda-remind-file'."
 206   (interactive)
 207   (apply 'org2rem t (org-agenda-files t)))
 208
 209 (defun org2rem (combine &rest files)
 210   "Create Remind files for all elements of FILES.
 211 If COMBINE is non-nil, combine all calendar entries into a single large
 212 file and store it under the name `org-combined-agenda-remind-file'."
 213   (save-excursion
 214     (org-prepare-agenda-buffers files)
 215     (let* ((dir (org-export-directory
 216                  :ical (list :publishing-directory
 217                              org-export-publishing-directory)))
 218            file rem-file rem-buffer category started org-agenda-new-buffers)
 219       (and (get-buffer "*rem-tmp*") (kill-buffer "*rem-tmp*"))
 220       (when combine
 221         (setq rem-file
 222               (if (file-name-absolute-p org-combined-agenda-remind-file)
 223                   org-combined-agenda-remind-file
 224                 (expand-file-name org-combined-agenda-remind-file dir))
 225               rem-buffer (org-get-agenda-file-buffer rem-file))
 226         (set-buffer rem-buffer) (erase-buffer))
 227       (while (setq file (pop files))
 228         (catch 'nextfile
 229           (org-check-agenda-file file)
 230           (set-buffer (org-get-agenda-file-buffer file))
 231           (unless combine
 232             (setq rem-file (concat (file-name-as-directory dir)
 233                                     (file-name-sans-extension
 234                                      (file-name-nondirectory buffer-file-name))
 235                                     ".rem"))
 236             (setq rem-buffer (org-get-agenda-file-buffer rem-file))
 237             (with-current-buffer rem-buffer (erase-buffer)))
 238           (setq category (or org-category
 239                              (file-name-sans-extension
 240                               (file-name-nondirectory buffer-file-name))))
 241           (if (symbolp category) (setq category (symbol-name category)))
 242           (let ((standard-output rem-buffer))
 243             (if combine
 244                 (and (not started) (setq started t)
 245                      (org-start-remind-file org-remind-combined-name))
 246               (org-start-remind-file category))
 247             (org-print-remind-entries combine)
 248             (when (or (and combine (not files)) (not combine))
 249               (org-finish-remind-file)
 250               (set-buffer rem-buffer)
 251               (run-hooks 'org-before-save-Remind-file-hook)
 252               (save-buffer)
 253               (run-hooks 'org-after-save-Remind-file-hook)
 254               (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait))
 255               ))))
 256       (org-release-buffers org-agenda-new-buffers))))
 257
 258 (defvar org-before-save-Remind-file-hook nil
 259   "Hook run before  an Remind file has been saved.
 260 This can be used to modify the result of the export.")
 261
 262 (defvar org-after-save-Remind-file-hook nil
 263   "Hook run after an Remind file has been saved.
 264 The Remind buffer is still current when this hook is run.
 265 A good way to use this is to tell a desktop calenndar application to re-read
 266 the Remind file.")
 267
 268 (defvar org-agenda-default-appointment-duration) ; defined in org-agenda.el
 269 (defun org-print-remind-entries (&optional combine)
 270   "Print Remind entries for the current Org-mode file to `standard-output'.
 271 When COMBINE is non nil, add the category to each line."
 272   (require 'org-agenda)
 273   (let ((re1 (concat org-ts-regexp "\\|<%%([^>\n]+>"))
 274         (re2 (concat "--?-?\\(" org-ts-regexp "\\)"))
 275         (dts (org-rem-ts-to-string
 276               (format-time-string (cdr org-time-stamp-formats) (current-time))
 277               "start time:"))
 278         hd ts ts2 state status (inc t) pos b sexp rrule
 279         scheduledp deadlinep todo prefix due start
 280         tmp pri categories entry location summary desc uid
 281         remind-aw remind-ew (org-rem-ew org-remind-extra-warn-days)
 282         (org-rem-aw org-remind-advanced-warn-days)
 283         trigger diff-days (dos org-remind-deadline-over-scheduled)
 284         (suppress-last-newline org-remind-suppress-last-newline)
 285         (sexp-buffer (get-buffer-create "*rem-tmp*")))
 286     (org-refresh-category-properties)
 287     (save-excursion
 288       (goto-char (point-min))
 289       (while (re-search-forward re1 nil t)
 290         (catch :skip
 291           (org-agenda-skip)
 292           (when (boundp 'org-remind-verify-function)
 293             (unless (funcall org-remind-verify-function)
 294               (outline-next-heading)
 295               (backward-char 1)
 296               (throw :skip nil)))
 297           (setq pos (match-beginning 0)
 298                 ts (match-string 0)
 299                 inc t
 300                 hd (condition-case nil
 301                        (org-remind-cleanup-string
 302                         (org-get-heading))
 303                      (error (throw :skip nil)))
 304                 summary (org-remind-cleanup-string
 305                          (org-entry-get nil "SUMMARY"))
 306                 desc (org-remind-cleanup-string
 307                       (or (org-entry-get nil "DESCRIPTION")
 308                           (and org-remind-include-body (org-get-entry)))
 309                       t org-remind-include-body)
 310                 location (org-remind-cleanup-string
 311                           (org-entry-get nil "LOCATION"))
 312                 uid (if org-remind-store-UID
 313                         (org-id-get-create)
 314                       (or (org-id-get) (org-id-new)))
 315                 categories (org-export-get-remind-categories)
 316                 deadlinep nil scheduledp nil)
 317           (if (looking-at re2)
 318               (progn
 319                 (goto-char (match-end 0))
 320                 (setq ts2 (match-string 1)
 321                       inc (not (string-match "[0-9]\\{1,2\\}:[0-9][0-9]" ts2))))
 322             (setq tmp (buffer-substring (max (point-min)
 323                                              (- pos org-ds-keyword-length))
 324                                         pos)
 325                   ts2 (if (string-match "[0-9]\\{1,2\\}:[0-9][0-9]-\\([0-9]\\{1,2\\}:[0-9][0-9]\\)" ts)
 326                           (progn
 327                             (setq inc nil)
 328                             (replace-match "\\1" t nil ts))
 329                         ts)
 330                   deadlinep (string-match org-deadline-regexp tmp)
 331                   scheduledp (string-match org-scheduled-regexp tmp)
 332                   todo (org-get-todo-state)
 333                   ;; donep (org-entry-is-done-p)
 334                   ))
 335           (when (and
 336                  deadlinep
 337                  (if todo
 338                      (not (memq 'event-if-todo org-remind-use-deadline))
 339                    (not (memq 'event-if-not-todo org-remind-use-deadline))))
 340             (throw :skip t))
 341           (when (and
 342                  scheduledp
 343                  (if todo
 344                      (not (memq 'event-if-todo org-remind-use-scheduled))
 345                    (not (memq 'event-if-not-todo org-remind-use-scheduled))))
 346             (throw :skip t))
 347           (setq prefix (if deadlinep "DEADLINE-" (if scheduledp "SCHEDULED-" "TS-")))
 348           (if (or (string-match org-tr-regexp hd)
 349                   (string-match org-ts-regexp hd))
 350               (setq hd (replace-match "" t t hd)))
 351           (if (string-match "\\+\\([0-9]+\\)\\([dwmy]\\)>" ts)
 352               (setq rrule               ;is recurrence value. later give it good name.
 353                     (* (string-to-number
 354                         (cdr (assoc
 355                               (match-string 2 ts)
 356                               '(("d" . "1")("w" . "7")
 357                                 ("m" . "0")("y" . "0")))))
 358                        (string-to-number (match-string 1 ts))))
 359             (setq rrule nil))
 360           (setq summary (or summary hd))
 361           (if (string-match org-bracket-link-regexp summary)
 362               (setq summary
 363                     (replace-match (if (match-end 3)
 364                                        (match-string 3 summary)
 365                                      (match-string 1 summary))
 366                                    t t summary)))
 367           (if deadlinep (setq summary (concat "DEADLINE: " summary)))
 368           (if scheduledp (setq summary (concat "SCHEDULED: " summary)))
 369           (if (string-match "\\`<%%" ts)
 370               (with-current-buffer sexp-buffer
 371                 (insert (substring ts 1 -1) " " summary "\n"))
 372             (princ (format "\n## BEGIN:EVENT
 373 ## UID: %s
 374 REM %s %s MSG EVENT:%s%s %s%s%%
 375 ## CATEGORIES:%s
 376 ## END:EVENT\n"
 377                            (concat prefix uid)
 378                            (org-rem-ts-to-string ts nil nil rrule)
 379                            (org-rem-ts-to-string ts2 "UNTIL " inc)
 380                            summary
 381                            (if (and desc (string-match "\\S-" desc))
 382                                (concat "%_\\\n" desc) "")
 383                            (if (and location (string-match "\\S-" location))
 384                                (concat "\nLOCATION: " location) "")
 385                            (if suppress-last-newline "" "%_")
 386                            categories)))))
 387
 388       (when (and org-remind-include-sexps
 389                  (condition-case nil (require 'remind) (error nil))
 390                  (fboundp 'remind-export-region))
 391         ;; Get all the literal sexps
 392         (goto-char (point-min))
 393         (while (re-search-forward "^&?%%(" nil t)
 394           (catch :skip
 395             (org-agenda-skip)
 396             (setq b (match-beginning 0))
 397             (goto-char (1- (match-end 0)))
 398             (forward-sexp 1)
 399             (end-of-line 1)
 400             (setq sexp (buffer-substring b (point)))
 401             (with-current-buffer sexp-buffer
 402               (insert sexp "\n"))))
 403         ;; (princ (org-diary-to-rem-string sexp-buffer))
 404         (kill-buffer sexp-buffer))
 405
 406       (when org-remind-include-todo
 407         (setq prefix "TODO-")
 408         (goto-char (point-min))
 409         (while (re-search-forward org-todo-line-regexp nil t)
 410           (catch :skip
 411             (org-agenda-skip)
 412             (when (boundp 'org-remind-verify-function)
 413               (unless (funcall org-remind-verify-function)
 414                 (outline-next-heading)
 415                 (backward-char 1)
 416                 (throw :skip nil)))
 417             (setq state (match-string 2))
 418             (setq status (if (member state org-done-keywords)
 419                              "COMPLETED" "NEEDS-ACTION"))
 420             (when (and state
 421                        (or (not (member state org-done-keywords))
 422                            (eq org-remind-include-todo 'all))
 423                        (not (member org-archive-tag (org-get-tags-at)))
 424                        )
 425               (setq hd (match-string 3)
 426                     summary (org-remind-cleanup-string
 427                              (org-entry-get nil "SUMMARY"))
 428                     desc (org-remind-cleanup-string
 429                           (or (org-entry-get nil "DESCRIPTION")
 430                               (and org-remind-include-body (org-get-entry)))
 431                           t org-remind-include-body)
 432                     location (org-remind-cleanup-string
 433                               (org-entry-get nil "LOCATION"))
 434                     due (and (member 'todo-due org-remind-use-deadline)
 435                              (org-entry-get nil "DEADLINE"))
 436                     start (and (member 'todo-start org-remind-use-scheduled)
 437                              (org-entry-get nil "SCHEDULED"))
 438                     categories (org-export-get-remind-categories)
 439                     uid (if org-remind-store-UID
 440                             (org-id-get-create)
 441                           (or (org-id-get) (org-id-new))))
 442
 443               (if (and due start)
 444                   (setq diff-days (org-rem-time-diff-days due start)))
 445
 446               (setq remind-aw
 447                     (if due
 448                         (if diff-days
 449                             (if (> diff-days 0)
 450                                 (if dos diff-days 0)
 451                               (if dos 0 diff-days))
 452                           1000)))
 453
 454               (if (and (numberp org-rem-aw) (> org-rem-aw 0))
 455                   (setq remind-aw (+ (or remind-aw 0) org-rem-aw)))
 456
 457               (setq remind-ew
 458                     (if due
 459                         (if diff-days
 460                             (if (> diff-days 0) due nil)
 461                           due)))
 462
 463               (setq trigger (if dos (if due due start) (if start start due)))
 464               ;; (and trigger (setq trigger (org-rem-ts-to-string trigger nil nil 1 remind-aw)))
 465               (if trigger
 466                    (setq trigger (concat
 467                                   (format "[trigger('%s')] *%d "
 468                                           (org-rem-ts-to-remind-date-type trigger) 1)
 469                                   (if remind-aw (format "++%d" remind-aw)))))
 470               (and due (setq due (org-rem-ts-to-remind-date-type due)))
 471               (and start (setq start (org-rem-ts-to-remind-date-type start)))
 472               (and remind-ew (setq remind-ew (org-rem-ts-to-remind-date-type remind-ew)))
 473
 474               (if (string-match org-bracket-link-regexp hd)
 475                   (setq hd (replace-match (if (match-end 3) (match-string 3 hd)
 476                                             (match-string 1 hd))
 477                                           t t hd)))
 478               (if (string-match org-priority-regexp hd)
 479                   (setq pri (string-to-char (match-string 2 hd))
 480                         hd (concat (substring hd 0 (match-beginning 1))
 481                                    (substring hd (match-end 1))))
 482                 (setq pri org-default-priority))
 483               (setq pri (floor (1+ (* 8. (/ (float (- org-lowest-priority pri))
 484                                             (- org-lowest-priority org-highest-priority))))))
 485
 486               (princ (format "\n## BEGIN:TODO
 487 ## UID: %s
 488 REM %s %s %s MSG TODO: %s%s%s%s%s%s%%
 489 ## CATEGORIES:%s
 490 ## SEQUENCE:1
 491 ## STATUS:%s
 492 ## END:TODO\n"
 493                              (concat prefix uid)
 494                              (or trigger "") ;; dts)
 495                              (if remind-ew (format "UNTIL [trigger('%s' + %d)]" remind-ew (or org-rem-ew 0)) "")
 496                              (if pri (format "PRIORITY %d" pri) "")
 497                              (or summary hd)
 498                              (if (and desc (string-match "\\S-" desc))
 499                                  (concat "%_\\\nDESCRIPTION: " desc) "")
 500                              (if (and location (string-match "\\S-" location))
 501                                  (concat "LOCATION: " location) "")
 502                              (if start
 503                                  (concat
 504                                   "%_\\\n['" start "' - today()] "
 505                                   "days over, for scheduled date - "
 506                                   "[trigger('" start "')]") "")
 507                              (if due
 508                                  (concat
 509                                   "%_\\\n[today() - '" due "'] "
 510                                   "days left, to deadline date - "
 511                                   "[trigger('" due "')]") "")
 512                              (if suppress-last-newline "" "%_")
 513                              categories
 514                              status)))))))))
 515
 516 (defun org-export-get-remind-categories ()
 517   "Get categories according to `org-remind-categories'."
 518   (let ((cs org-remind-categories) c rtn tmp)
 519     (while (setq c (pop cs))
 520       (cond
 521        ((eq c 'category) (push (org-get-category) rtn))
 522        ((eq c 'todo-state)
 523         (setq tmp (org-get-todo-state))
 524         (and tmp (push tmp rtn)))
 525        ((eq c 'local-tags)
 526         (setq rtn (append (nreverse (org-get-local-tags-at (point))) rtn)))
 527        ((eq c 'all-tags)
 528         (setq rtn (append (nreverse (org-get-tags-at (point))) rtn)))))
 529     (mapconcat 'identity (nreverse rtn) ",")))
 530
 531 (defun org-remind-cleanup-string (s &optional is-body maxlength)
 532   "Take out stuff and quote what needs to be quoted.
 533 When IS-BODY is non-nil, assume that this is the body of an item, clean up
 534 whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH
 535 characters."
 536   (if (or (not s) (string-match "^[ \t\n]*$" s))
 537       nil
 538     (when is-body
 539       (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?"))
 540             (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?")))
 541         (while (string-match re s) (setq s (replace-match "" t t s)))
 542         (while (string-match re2 s) (setq s (replace-match "" t t s)))))
 543     (if org-remind-escape-percentage
 544         (let ((start 0))
 545           (while (string-match "\\([%]\\)" s start)
 546             (setq start (+ (match-beginning 0) 2)
 547                   s (replace-match "\\1\\1" nil nil s)))))
 548
 549     (let ((start 0))
 550       (while (string-match "\\([\n]\\)" s start)
 551         (setq start (+ (match-beginning 0) 4) ;; less than 4 is not correct.
 552               s (replace-match "%_\\\\\\1" nil nil s))))
 553
 554     (let ((start 0))
 555       (while (string-match "\\([[]\\)" s start)
 556         (setq start (+ (match-beginning 0) 5)
 557               s (replace-match (concat "\[" "\"" "\\1" "\"" "\]") nil nil s))))
 558
 559 ;;;     (when is-body
 560 ;;;       (while (string-match "[ \t]*\n[ \t]*" s)
 561 ;;;     (setq s (replace-match "%_" t t s))))
 562
 563     (setq s (org-trim s))
 564     (if is-body
 565         (if maxlength
 566             (if (and (numberp maxlength)
 567                      (> (length s) maxlength))
 568                 (setq s (substring s 0 maxlength)))))
 569     s))
 570
 571 (defun org-get-entry ()
 572   "Clean-up description string."
 573   (save-excursion
 574     (org-back-to-heading t)
 575     (buffer-substring (point-at-bol 2) (org-end-of-subtree t))))
 576
 577 (defun org-start-remind-file (name)
 578   "Start an Remind file by inserting the header."
 579   (let ((user user-full-name)
 580         (name (or name "unknown"))
 581         (timezone (cadr (current-time-zone))))
 582     (princ
 583      (format "# -*- Mode: shell-script; auto-fill-mode: nil -*-
 584 ## BEGIN: Reminders
 585 ## VERSION:2.0
 586 ## Emacs with Org-mode
 587 ## Calendar:%s
 588 ## Created by: %s
 589 ## Timezone:%s
 590 ## Calscale:Gregorian\n" name user timezone))))
 591
 592 (defun org-finish-remind-file ()
 593   "Finish an Remind file by inserting the END statement."
 594   (princ "\n## END:Reminders\n"))
 595
 596 (defun org-rem-ts-to-remind-date-type (s)
 597   (format-time-string
 598          "%Y-%m-%d"
 599          (apply 'encode-time (butlast (org-parse-time-string s) 3))))
 600
 601 ;; (defun org-rem-date-type-to-string (s keyword &optional inc day-repeat day-advance-warn)
 602 ;;   (if trigger
 603 ;;       (setq trigger
 604 ;;             (concat
 605 ;;              (format "[trigger('%s')] *%d "
 606 ;;                      (org-rem-ts-to-remind-date-type trigger) day-repeat)
 607 ;;              (if day-advance-warn (format "++%d" day-advance-warn))))))
 608
 609 ;; (format-time-string "%Y"
 610 ;;  (apply 'encode-time (butlast (org-parse-time-string "<2008-11-20 Thu 10:30>") 3)))
 611
 612 (defun org-rem-ts-to-string (s keyword &optional inc day-repeat day-advance-warn)
 613   "Take a time string S and convert it to Remind format.
 614 KEYWORD is added in front, to make a complete line like DTSTART....
 615 When INC is non-nil, increase the hour by two (if time string contains
 616 a time), or the day by one (if it does not contain a time)."
 617   (let ((t1 (org-parse-time-string s 'nodefault))
 618         t2 fmt have-time time)
 619     (if (and (car t1) (nth 1 t1) (nth 2 t1))
 620         (setq t2 t1 have-time t)
 621       (setq t2 (org-parse-time-string s)))
 622     (let ((s (car t2))   (mi (nth 1 t2)) (h (nth 2 t2))
 623           (d (nth 3 t2)) (m  (nth 4 t2)) (y (nth 5 t2)))
 624       (when inc
 625         (if have-time
 626             (if org-agenda-default-appointment-duration
 627                 (setq mi (+ org-agenda-default-appointment-duration mi))
 628               (setq h (+ 2 h)))
 629           (setq d (1+ d))))
 630       (setq time (encode-time s mi h d m y)))
 631     (setq fmt (concat
 632                "%d %b %Y"
 633                (if day-advance-warn (format " ++%d" day-advance-warn))
 634                (if day-repeat (format " *%d" day-repeat))
 635                (if have-time " AT %H:%M")))
 636     (concat keyword (format-time-string fmt time))))
 637
 638 (defun org-rem-time-diff-days (end start)
 639   (floor (/ (apply '- (mapcar
 640              (lambda (s)
 641                (let*
 642                    ((t1 (org-parse-time-string s))
 643                     (s (car t1)) (mi (nth 1 t1))
 644                     (h (nth 2 t1)) (d (nth 3 t1))
 645                     (m  (nth 4 t1)) (y (nth 5 t1)))
 646                  (float-time (encode-time s mi h d m y))))
 647              (list end start))) (* 24 60 60))))
 648
 649 (provide 'org2rem)
 650
 651 ;; arch-tag: 65985fe9-095c-49c7-a7b6-cb4ee15c0a95
 652
 653 ;;; org-exp.el ends here