Commit b9661543 authored by Carsten Dominik's avatar Carsten Dominik
Browse files

(org-special-keyword): New face.

	(org-table-copy-down, org-table-eval-formula)
	(org-table-recalculate, org-init-section-numbers): Use
	`string-to-number' instead of `string-to-int'.
	(org-get-location): Use `insert-buffer-substring' instead of
	`insert-buffer'.
	(org-modify-diary-entry-string): New function.
	(org-get-entries-from-diary): Set the hook for
	`add-to-diary-list'.
	(org-disable-agenda-to-diary): renamed from `org-disable-diary'.
	(org-toggle-fixed-width-section): Use QUOTE keyword if there is no
	active region.
	(org-export-as-html): Handle QUOTE keyword.
	(org-quote-string): New option.
	(org-bookmark-jump-unhide): New function, used for
	`bookmark-after-jump-hook'.
	(org-diary-default-entry): Apply only when not called through
	`org-agenda'.
parent f720b30e
;; org.el --- Outline-based notes management and organizer
;;; org.el --- Outline-based notes management and organizer
;; Carstens outline-mode for keeping track of everything.
;; Copyright (C) 2004, 2005 Free Software Foundation, Inc.
;; Copyright (c) 2004, 2005 Free Software Foundation
;;
;; Author: Carsten Dominik <dominik at science dot uva dot nl>
;; Keywords: outlines, hypermedia, calendar
;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/
;; Version: 3.14
;; Version: 3.15
;;
;; This file is part of GNU Emacs.
;;
......@@ -81,6 +80,13 @@
;;
;; Changes:
;; -------
;; Version 3.15
;; - QUOTE keyword at the beginning of an entry causes fixed-width export
;; of unmodified entry text. `C-c :' toggles this keyword.
;; - New face `org-special-keyword' which is used for COMMENT, QUOTE,
;; DEADLINE and SCHEDULED, and priority cookies. Default is only a weak
;; color, to reduce the amount of aggressive color in the buffer.
;;
;; Version 3.14
;; - Formulas for individual fields in table.
;; - Automatic recalculation in calculating tables.
......@@ -189,7 +195,7 @@
;;; Customization variables
(defvar org-version "3.14"
(defvar org-version "3.15"
"The version number of the file org.el.")
(defun org-version ()
(interactive)
......@@ -388,6 +394,15 @@ Changes become only effective after restarting Emacs."
:group 'org-keywords
:type 'string)
(defcustom org-quote-string "QUOTE"
"Entries starting with this keyword will be exported in fixed-width font.
Quoting applies only to the text in the entry following the headline, and does
not extend beyond the next headline, even if that is lower level.
An entry can be toggled between QUOTE and normal with
\\[org-toggle-fixed-width-section]"
:group 'org-keywords
:type 'string)
(defcustom org-after-todo-state-change-hook nil
"Hook which is run after the state of a TODO item was changed.
The new state (a string with a todo keyword, or nil) is available in the
......@@ -1593,6 +1608,14 @@ Otherwise, the buffer will just be saved to a file and stay hidden."
"Face used for level 8 headlines."
:group 'org-faces)
(defface org-special-keyword ;; font-lock-string-face
'((((type tty) (class color)) (:foreground "green"))
(((class color) (background light)) (:foreground "RosyBrown"))
(((class color) (background dark)) (:foreground "LightSalmon"))
(t (:italic t)))
"Face used for level 8 headlines."
:group 'org-faces)
(defface org-warning ;; font-lock-warning-face
'((((type tty) (class color)) (:foreground "red"))
(((class color) (background light)) (:foreground "Red" :bold t))
......@@ -1919,17 +1942,22 @@ The following commands are available:
'(org-activate-dates (0 'org-link))
(list (concat "^\\*+[ \t]*" org-not-done-regexp)
'(1 'org-warning t))
(list (concat "\\[#[A-Z]\\]") '(0 'org-warning t))
(list (concat "\\<" org-deadline-string) '(0 'org-warning t))
(list (concat "\\<" org-scheduled-string) '(0 'org-warning t))
(list (concat "\\[#[A-Z]\\]") '(0 'org-special-keyword t))
; (list (concat "\\<" org-deadline-string) '(0 'org-warning t))
; (list (concat "\\<" org-scheduled-string) '(0 'org-warning t))
(list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t))
(list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t))
;; '("\\(\\s-\\|^\\)\\(\\*\\([a-zA-Z]+\\)\\*\\)\\([^a-zA-Z*]\\|$\\)"
;; (3 'bold))
;; '("\\(\\s-\\|^\\)\\(/\\([a-zA-Z]+\\)/\\)\\([^a-zA-Z*]\\|$\\)"
;; (3 'italic))
;; '("\\(\\s-\\|^\\)\\(_\\([a-zA-Z]+\\)_\\)\\([^a-zA-Z*]\\|$\\)"
;; (3 'underline))
(list (concat "^\\*+[ \t]*\\<\\(" org-comment-string "\\)\\>")
'(1 'org-warning t))
; (list (concat "^\\*+[ \t]*\\<\\(" org-comment-string "\\)\\>")
; '(1 'org-warning t))
(list (concat "^\\*+[ \t]*\\<\\(" org-comment-string
"\\|" org-quote-string "\\)\\>")
'(1 'org-special-keyword t))
'("^#.*" (0 'font-lock-comment-face t))
(if org-fontify-done-headline
(list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\(.*\\)\\>")
......@@ -2216,7 +2244,7 @@ or nil."
(shrink-window-if-larger-than-buffer (get-buffer-window "*Help*"))
(setq buffer-read-only nil)
(erase-buffer)
(insert-buffer buf)
(insert-buffer-substring buf)
(let ((org-startup-truncated t)
(org-startup-folded t)
(org-startup-with-deadline-check nil))
......@@ -4013,7 +4041,7 @@ With prefix ARG, go back that many times `org-agenda-ndays'."
(get-text-property (point) 'org-marker))
(org-agenda-show)))
(defvar org-disable-diary nil) ;Dynamically-scoped param.
(defvar org-disable-agenda-to-diary nil) ;Dynamically-scoped param.
(defun org-get-entries-from-diary (date)
"Get the (Emacs Calendar) diary entries for DATE."
......@@ -4021,8 +4049,10 @@ With prefix ARG, go back that many times `org-agenda-ndays'."
(diary-display-hook '(fancy-diary-display))
(list-diary-entries-hook
(cons 'org-diary-default-entry list-diary-entries-hook))
(diary-file-name-prefix-function nil) ; turn this feature off
(diary-modify-entry-list-string-function 'org-modify-diary-entry-string)
entries
(org-disable-diary t))
(org-disable-agenda-to-diary t))
(save-excursion
(save-window-excursion
(list-diary-entries date 1)))
......@@ -4076,15 +4106,21 @@ date. Itt also removes lines that contain only whitespace."
(if (re-search-forward "^Org-mode dummy\n?" nil t)
(replace-match "")))
;; Advise the add-to-diary-list function to allow org to jump to
;; diary entries. Wrapped into eval-after-load to avoid loading
;; advice unnecessarily
;; Make sure entries from the diary have the right text properties.
(eval-after-load "diary-lib"
'(defadvice add-to-diary-list (before org-mark-diary-entry activate)
'(if (boundp 'diary-modify-entry-list-string-function)
;; We can rely on the hook, nothing to do
nil
;; Hook not avaiable, must use advice to make this work
(defadvice add-to-diary-list (before org-mark-diary-entry activate)
"Make the position visible."
(if (and org-disable-diary ;; called from org-agenda
(if (and org-disable-agenda-to-diary ;; called from org-agenda
(stringp string)
(buffer-file-name))
(setq string (org-modify-diary-entry-string string))))))
(defun org-modify-diary-entry-string (string)
"Add text properties to string, allowing org-mode to act on it."
(add-text-properties
0 (length string)
(list 'mouse-face 'highlight
......@@ -4095,16 +4131,18 @@ date. Itt also removes lines that contain only whitespace."
(abbreviate-file-name (buffer-file-name)))
'org-agenda-diary-link t
'org-marker (org-agenda-new-marker (point-at-bol)))
string))))
string)
string)
(defun org-diary-default-entry ()
"Add a dummy entry to the diary.
Needed to avoid empty dates which mess up holiday display."
;; Catch the error if dealing with the new add-to-diary-alist
(when org-disable-agenda-to-diary
(condition-case nil
(add-to-diary-list original-date "Org-mode dummy" "")
(error
(add-to-diary-list original-date "Org-mode dummy" "" nil))))
(add-to-diary-list original-date "Org-mode dummy" "" nil)))))
(defun org-add-file (&optional file)
"Add current file to the list of files in variable `org-agenda-files'.
......@@ -4238,11 +4276,12 @@ function from a program - use `org-agenda-get-day-entries' instead."
file rtn results)
;; If this is called during org-agenda, don't return any entries to
;; the calendar. Org Agenda will list these entries itself.
(if org-disable-diary (setq files nil))
(if org-disable-agenda-to-diary (setq files nil))
(while (setq file (pop files))
(setq rtn (apply 'org-agenda-get-day-entries file date args))
(setq results (append results rtn)))
(concat (org-finalize-agenda-entries results) "\n")))
(if results
(concat (org-finalize-agenda-entries results) "\n"))))
(defun org-agenda-get-day-entries (file date &rest args)
"Does the work for `org-diary' and `org-agenda'.
......@@ -6270,7 +6309,7 @@ integer, it will be incremented while copying."
(progn
(if (and org-table-copy-increment
(string-match "^[0-9]+$" txt))
(setq txt (format "%d" (+ (string-to-int txt) 1))))
(setq txt (format "%d" (+ (string-to-number txt) 1))))
(insert txt)
(org-table-maybe-recalculate-line)
(org-table-align))
......@@ -6997,9 +7036,9 @@ If NLAST is a number, only the NLAST fields will actually be summed."
(t n))))
(defun org-table-get-vertical-vector (desc &optional tbeg col)
"Get a calc vector from a column, according to descriptor DESC.
Optional arguments TBEG and COL can give the beginning of the table
and the current column, to avoid unnecessary parsing."
"Get a calc vector from a column, accorting to desctiptor DESC.
Optional arguments TBEG and COL can give the beginning of the table and
the current column, to avoid unnecessary parsing."
(save-excursion
(or tbeg (setq tbeg (org-table-begin)))
(or col (setq col (org-table-current-column)))
......@@ -7440,7 +7479,7 @@ not overwrite the stored one."
;; Insert the references to fields in same row
(while (string-match "\\$\\([0-9]+\\)?" form)
(setq n (if (match-beginning 1)
(string-to-int (match-string 1 form))
(string-to-number (match-string 1 form))
n0)
x (nth (1- n) fields))
(unless x (error "Invalid field specifier \"%s\""
......@@ -7539,7 +7578,7 @@ $1-> %s\n" orig formula form))
(setq eql eqlnum)
(while (setq entry (pop eql))
(goto-line org-last-recalc-line)
(org-table-goto-column (string-to-int (car entry)) nil 'force)
(org-table-goto-column (string-to-number (car entry)) nil 'force)
(org-table-eval-formula nil (cdr entry) 'noalign 'nocst 'nostore))))
(goto-line thisline)
(org-table-goto-column thiscol)
......@@ -7801,7 +7840,7 @@ table editor in arbitrary modes.")
(and c (setq minor-mode-map-alist
(cons c (delq c minor-mode-map-alist)))))
(set (make-local-variable (quote org-table-may-need-update)) t)
(make-local-hook (quote before-change-functions))
(make-local-hook (quote before-change-functions)) ; needed for XEmacs
(add-hook 'before-change-functions 'org-before-change-function
nil 'local)
(set (make-local-variable 'org-old-auto-fill-inhibit-regexp)
......@@ -8620,14 +8659,13 @@ Does include HTML export options as well as TODO and CATEGORY stuff."
(insert s)))
(defun org-toggle-fixed-width-section (arg)
"Toggle the fixed-width indicator at the beginning of lines in the region.
If there is no active region, only acts on the current line.
If the first non-white character in the first line of the region is a
vertical bar \"|\", then the command removes the bar from all lines in
the region. If the first character is not a bar, the command adds a
bar to all lines, in the column given by the beginning of the region.
If there is a numerical prefix ARG, create ARG new lines starting with \"|\"."
"Toggle the fixed-width export.
If there is no active region, the QUOTE keyword at the current headline is
inserted or removed. When present, it causes the text between this headline
and the next to be exported as fixed-width text, and unmodified.
If there is an active region, this command adds or removes a colon as the
first character of this line. If the first character of a line is a colon,
this line is also exported in fixed-width font."
(interactive "P")
(let* ((cc 0)
(regionp (org-region-active-p))
......@@ -8636,6 +8674,7 @@ If there is a numerical prefix ARG, create ARG new lines starting with \"|\"."
(nlines (or arg (if (and beg end) (count-lines beg end) 1)))
(re "[ \t]*\\(:\\)")
off)
(if regionp
(save-excursion
(goto-char beg)
(setq cc (current-column))
......@@ -8652,7 +8691,16 @@ If there is a numerical prefix ARG, create ARG new lines starting with \"|\"."
((and off (looking-at re))
(replace-match "" t t nil 1))
((not off) (move-to-column cc t) (insert ":")))
(forward-line 1)))))
(forward-line 1)))
(save-excursion
(org-back-to-heading)
(if (looking-at (concat outline-regexp
"\\( +\\<" org-quote-string "\\>\\)"))
(replace-match "" t t nil 1)
(if (looking-at outline-regexp)
(progn
(goto-char (match-end 0))
(insert " " org-quote-string))))))))
(defun org-export-as-html-and-open (arg)
"Export the outline as HTML and immediately open it with a browser.
......@@ -8699,6 +8747,8 @@ headlines. The default is 3. Lower levels will become bulleted lists."
(author user-full-name)
(title (buffer-name))
(options nil)
(quote-re (concat "^\\*+[ \t]*" org-quote-string "\\>"))
(inquote nil)
(email user-mail-address)
(language org-export-default-language)
(text nil)
......@@ -8802,7 +8852,18 @@ headlines. The default is 3. Lower levels will become bulleted lists."
))
(setq head-count 0)
(org-init-section-numbers)
(while (setq line (pop lines) origline line)
;; end of quote?
(when (and inquote (string-match "^\\*+" line))
(insert "</pre>\n")
(setq inquote nil))
;; inquote
(if inquote
(progn
(insert line "\n")
(setq line (org-html-expand line))) ;;????? FIXME: not needed?
;; Protect the links
(setq start 0)
(while (string-match org-link-maybe-angles-regexp line start)
......@@ -8828,6 +8889,7 @@ headlines. The default is 3. Lower levels will become bulleted lists."
(not (string-match "^[ \t]+\\(:.*\\)"
(car lines))))
"<br>\n" "\n"))))
(setq start 0)
(while (string-match org-protected-link-regexp line start)
(setq start (- (match-end 0) 2))
......@@ -8836,7 +8898,7 @@ headlines. The default is 3. Lower levels will become bulleted lists."
((member type '("http" "https" "ftp" "mailto" "news"))
;; standard URL
(setq line (replace-match
; "<a href=\"\\1:\\2\">&lt;\\1:\\2&gt;</a>"
; "<a href=\"\\1:\\2\">&lt;\\1:\\2&gt;</a>"
"<a href=\"\\1:\\2\">\\1:\\2</a>"
nil nil line)))
((string= type "file")
......@@ -8882,6 +8944,7 @@ headlines. The default is 3. Lower levels will become bulleted lists."
(setq line (replace-match "<span style='color:red'>\\&</span>"
nil nil line 1)))))
(cond
((string-match "^\\(\\*+\\)[ \t]*\\(.*\\)" line)
;; This is a headline
......@@ -8890,7 +8953,11 @@ headlines. The default is 3. Lower levels will become bulleted lists."
(if (<= level umax) (setq head-count (+ head-count 1)))
(org-html-level-start level txt umax
(and org-export-with-toc (<= level umax))
head-count))
head-count)
;; QUOTES
(when (string-match quote-re line)
(insert "<pre>")
(setq inquote t)))
((and org-export-with-tables
(string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line))
......@@ -8913,7 +8980,7 @@ headlines. The default is 3. Lower levels will become bulleted lists."
;; FIXME: Should we add + and *?
(if (string-match "^ *-\\|^[ \t]*$" line) (insert "<p>"))
(insert line (if org-export-preserve-breaks "<br>\n" "\n"))))
))
)))
(if org-export-html-with-timestamp
(insert org-export-html-html-helper-timestamp))
(insert "</body>\n</html>\n")
......@@ -9229,7 +9296,7 @@ stacked delimiters is N. Escaping delimiters is not possible."
(if (string-match "\\`[A-Z]\\'" number-string)
(aset org-section-numbers i
(- (string-to-char number-string) ?A -1))
(aset org-section-numbers i (string-to-int number-string)))
(aset org-section-numbers i (string-to-number number-string)))
(pop numbers))
(setq i (1- i)))))
......@@ -9998,14 +10065,23 @@ Show the heading too, if it is currently invisible."
"\\):[ \t]*"
(if org-noutline-p "\\(.+\\)" "\\([^\n\r]+\\)")))
;; Advise the bookmark-jump function to make jump position visible
;; Wrapped into eval-after-load to avoid loading advice unnecessarily
;; Make `bookmark-jump' show the jump location if it was hidden.
(eval-after-load "bookmark"
'(defadvice bookmark-jump (after org-make-visible activate)
'(if (boundp 'bookmark-after-jump-hook)
;; We can use the hook
(add-hook 'bookmark-after-jump-hook 'org-bookmark-jump-unhide)
;; Hook not available, use advice
(defadvice bookmark-jump (after org-make-visible activate)
"Make the position visible."
(org-bookmark-jump-unhide))))
(defun org-bookmark-jump-unhide ()
"Unhide the current position, to show the bookmark location."
(and (eq major-mode 'org-mode)
(org-invisible-p)
(org-show-hierarchy-above))))
(or (org-invisible-p)
(save-excursion (goto-char (max (point-min) (1- (point))))
(org-invisible-p)))
(org-show-hierarchy-above)))
;;; Finish up
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment