浏览代码

Added support for :maxlevel and :skip-empty-rows parameters to columnview dblock.

Bastien Guerry 17 年之前
父节点
当前提交
f247d16417
共有 3 个文件被更改,包括 73 次插入40 次删除
  1. 16 5
      ChangeLog
  2. 47 31
      org.el
  3. 10 4
      org.texi

+ 16 - 5
ChangeLog

@@ -1,4 +1,15 @@
-2008-02-29  Bastien Guerry  <Bastien.Guerry@ens.fr>
+2008-03-01  Bastien Guerry  <bzg@altern.org>
+
+	* org.texi (Capturing Column View): Documented new parameters for
+	the column view dynamic block: :maxlevel and :skip-empty-rows.
+
+2008-03-01  Bastien Guerry  <bzg@altern.org>
+
+	* org.el (org-dblock-write:columnview, org-columns-capture-view):
+	Added support for :maxlevel and :skip-empty-rows as argument for
+	the columnview dynamic block.
+
+2008-02-29  Bastien Guerry  <bzg@altern.org>
 
 
 	* org-irc.el: Require 'cl and 'erc.  Added dynamically scoped
 	* org-irc.el: Require 'cl and 'erc.  Added dynamically scoped
 	variables.
 	variables.
@@ -88,7 +99,7 @@
 	customizable.
 	customizable.
 	(org-default-extensions): New option.
 	(org-default-extensions): New option.
 
 
-2008-02-26  Bastien Guerry  <Bastien.Guerry@ens.fr>
+2008-02-26  Bastien Guerry  <bzg@altern.org>
 
 
 	* org.el (org-agenda-to-appt): New argument `refresh' let the user
 	* org.el (org-agenda-to-appt): New argument `refresh' let the user
 	delete previous appointments stored in `appt-time-msg-list'.
 	delete previous appointments stored in `appt-time-msg-list'.
@@ -448,7 +459,7 @@ Installed as 5.19a
 	(Quoted examples): New section.
 	(Quoted examples): New section.
 	(Enhancing text): New verbatim environments.
 	(Enhancing text): New verbatim environments.
 
 
-2007-11-04  Bastien Guerry  <Bastien.Guerry@ens.fr>
+2007-11-04  Bastien Guerry  <bzg@altern.org>
 
 
 	* org.el (org-export-with-special-strings): New option.
 	* org.el (org-export-with-special-strings): New option.
 	(org-export-html-convert-special-strings): New function.
 	(org-export-html-convert-special-strings): New function.
@@ -656,7 +667,7 @@ Installed as 5.11
 
 
 	* org.texi (Appointment reminders): New section.
 	* org.texi (Appointment reminders): New section.
 
 
-2007-10-05  Bastien Guerry  <Bastien.Guerry@ens.fr>
+2007-10-05  Bastien Guerry  <bzg@altern.org>
 
 
 	* org-export-latex.el (org-export-latex-protect-string): 
 	* org-export-latex.el (org-export-latex-protect-string): 
         Renaming of `org-latex-protect'.
         Renaming of `org-latex-protect'.
@@ -700,7 +711,7 @@ Installed as 5.10
 	(org-indent-item): Fix bullet type before thinking about
 	(org-indent-item): Fix bullet type before thinking about
 	renumbering.
 	renumbering.
 
 
-2007-09-26  Bastien Guerry  <Bastien.Guerry@ens.fr>
+2007-09-26  Bastien Guerry  <bzg@altern.org>
 
 
 	* org-export-latex.el (org-export-latex-emphasis-alist): 
 	* org-export-latex.el (org-export-latex-emphasis-alist): 
 	Each list of the alist now requires three elements.
 	Each list of the alist now requires three elements.

+ 47 - 31
org.el

@@ -1255,7 +1255,7 @@ Needs to be set before org.el is loaded."
   :group 'org-link-follow
   :group 'org-link-follow
   :type 'boolean)
   :type 'boolean)
 
 
-(defcustom org-mouse-1-follows-link 
+(defcustom org-mouse-1-follows-link
   (if (boundp 'mouse-1-click-follows-link) mouse-1-click-follows-link t)
   (if (boundp 'mouse-1-click-follows-link) mouse-1-click-follows-link t)
   "Non-nil means, mouse-1 on a link will follow the link.
   "Non-nil means, mouse-1 on a link will follow the link.
 A longer mouse click will still set point.  Does not work on XEmacs.
 A longer mouse click will still set point.  Does not work on XEmacs.
@@ -12729,7 +12729,7 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
 		(setq type (match-string 1 link) path (match-string 2 link))
 		(setq type (match-string 1 link) path (match-string 2 link))
 	      (setq type "thisfile" path link))
 	      (setq type "thisfile" path link))
 	    (throw 'match t)))
 	    (throw 'match t)))
-	
+
 	(when (get-text-property (point) 'org-linked-text)
 	(when (get-text-property (point) 'org-linked-text)
 	  (setq type "thisfile"
 	  (setq type "thisfile"
 		pos (if (get-text-property (1+ (point)) 'org-linked-text)
 		pos (if (get-text-property (1+ (point)) 'org-linked-text)
@@ -12738,7 +12738,7 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
 		      (previous-single-property-change pos 'org-linked-text)
 		      (previous-single-property-change pos 'org-linked-text)
 		      (next-single-property-change pos 'org-linked-text)))
 		      (next-single-property-change pos 'org-linked-text)))
 	  (throw 'match t))
 	  (throw 'match t))
-	
+
 	(save-excursion
 	(save-excursion
 	  (when (or (org-in-regexp org-angle-link-re)
 	  (when (or (org-in-regexp org-angle-link-re)
 		    (org-in-regexp org-plain-link-re))
 		    (org-in-regexp org-plain-link-re))
@@ -12760,12 +12760,12 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
       ;; Remove any trailing spaces in path
       ;; Remove any trailing spaces in path
       (if (string-match " +\\'" path)
       (if (string-match " +\\'" path)
 	  (setq path (replace-match "" t t path)))
 	  (setq path (replace-match "" t t path)))
-      
+
       (cond
       (cond
-       
+
        ((assoc type org-link-protocols)
        ((assoc type org-link-protocols)
 	(funcall (nth 1 (assoc type org-link-protocols)) path))
 	(funcall (nth 1 (assoc type org-link-protocols)) path))
-       
+
        ((equal type "mailto")
        ((equal type "mailto")
 	(let ((cmd (car org-link-mailto-program))
 	(let ((cmd (car org-link-mailto-program))
 	      (args (cdr org-link-mailto-program)) args1
 	      (args (cdr org-link-mailto-program)) args1
@@ -12783,14 +12783,14 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
 		    (setq a (replace-match subject t t a)))
 		    (setq a (replace-match subject t t a)))
 		(push a args1))))
 		(push a args1))))
 	  (apply cmd (nreverse args1))))
 	  (apply cmd (nreverse args1))))
-       
+
        ((member type '("http" "https" "ftp" "news"))
        ((member type '("http" "https" "ftp" "news"))
 	(browse-url (concat type ":" (org-link-escape
 	(browse-url (concat type ":" (org-link-escape
 				      path org-link-escape-chars-browser))))
 				      path org-link-escape-chars-browser))))
-       
+
        ((member type '("message"))
        ((member type '("message"))
 	(browse-url (concat type ":" path)))
 	(browse-url (concat type ":" path)))
-       
+
        ((string= type "tags")
        ((string= type "tags")
 	(org-tags-view in-emacs path))
 	(org-tags-view in-emacs path))
        ((string= type "thisfile")
        ((string= type "thisfile")
@@ -12806,10 +12806,10 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
 		     ,pos)))
 		     ,pos)))
 	  (condition-case nil (eval cmd)
 	  (condition-case nil (eval cmd)
 	    (error (progn (widen) (eval cmd))))))
 	    (error (progn (widen) (eval cmd))))))
-       
+
        ((string= type "tree-match")
        ((string= type "tree-match")
 	(org-occur (concat "\\[" (regexp-quote path) "\\]")))
 	(org-occur (concat "\\[" (regexp-quote path) "\\]")))
-       
+
        ((string= type "file")
        ((string= type "file")
 	(if (string-match "::\\([0-9]+\\)\\'" path)
 	(if (string-match "::\\([0-9]+\\)\\'" path)
 	    (setq line (string-to-number (match-string 1 path))
 	    (setq line (string-to-number (match-string 1 path))
@@ -12820,16 +12820,16 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
 	(if (string-match "[*?{]" (file-name-nondirectory path))
 	(if (string-match "[*?{]" (file-name-nondirectory path))
 	    (dired path)
 	    (dired path)
 	  (org-open-file path in-emacs line search)))
 	  (org-open-file path in-emacs line search)))
-       
+
        ((string= type "news")
        ((string= type "news")
 	(org-follow-gnus-link path))
 	(org-follow-gnus-link path))
-       
+
        ((string= type "bbdb")
        ((string= type "bbdb")
 	(org-follow-bbdb-link path))
 	(org-follow-bbdb-link path))
-       
+
        ((string= type "info")
        ((string= type "info")
 	(org-follow-info-link path))
 	(org-follow-info-link path))
-       
+
        ((string= type "gnus")
        ((string= type "gnus")
 	(let (group article)
 	(let (group article)
 	  (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
 	  (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
@@ -12837,7 +12837,7 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
 	  (setq group (match-string 1 path)
 	  (setq group (match-string 1 path)
 		article (match-string 3 path))
 		article (match-string 3 path))
 	  (org-follow-gnus-link group article)))
 	  (org-follow-gnus-link group article)))
-       
+
        ((string= type "vm")
        ((string= type "vm")
 	(let (folder article)
 	(let (folder article)
 	  (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
 	  (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
@@ -12846,7 +12846,7 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
 		article (match-string 3 path))
 		article (match-string 3 path))
 	  ;; in-emacs is the prefix arg, will be interpreted as read-only
 	  ;; in-emacs is the prefix arg, will be interpreted as read-only
 	  (org-follow-vm-link folder article in-emacs)))
 	  (org-follow-vm-link folder article in-emacs)))
-       
+
        ((string= type "wl")
        ((string= type "wl")
 	(let (folder article)
 	(let (folder article)
 	  (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
 	  (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
@@ -12854,7 +12854,7 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
 	  (setq folder (match-string 1 path)
 	  (setq folder (match-string 1 path)
 		article (match-string 3 path))
 		article (match-string 3 path))
 	  (org-follow-wl-link folder article)))
 	  (org-follow-wl-link folder article)))
-       
+
        ((string= type "mhe")
        ((string= type "mhe")
 	(let (folder article)
 	(let (folder article)
 	  (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
 	  (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
@@ -12862,7 +12862,7 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
 	  (setq folder (match-string 1 path)
 	  (setq folder (match-string 1 path)
 		article (match-string 3 path))
 		article (match-string 3 path))
 	  (org-follow-mhe-link folder article)))
 	  (org-follow-mhe-link folder article)))
-       
+
        ((string= type "rmail")
        ((string= type "rmail")
 	(let (folder article)
 	(let (folder article)
 	  (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
 	  (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
@@ -12870,7 +12870,7 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
 	  (setq folder (match-string 1 path)
 	  (setq folder (match-string 1 path)
 		article (match-string 3 path))
 		article (match-string 3 path))
 	  (org-follow-rmail-link folder article)))
 	  (org-follow-rmail-link folder article)))
-       
+
        ((string= type "shell")
        ((string= type "shell")
 	(let ((cmd path))
 	(let ((cmd path))
 	  (if (or (not org-confirm-shell-link-function)
 	  (if (or (not org-confirm-shell-link-function)
@@ -12882,7 +12882,7 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
 		(message "Executing %s" cmd)
 		(message "Executing %s" cmd)
 		(shell-command cmd))
 		(shell-command cmd))
 	    (error "Abort"))))
 	    (error "Abort"))))
-       
+
        ((string= type "elisp")
        ((string= type "elisp")
 	(let ((cmd path))
 	(let ((cmd path))
 	  (if (or (not org-confirm-elisp-link-function)
 	  (if (or (not org-confirm-elisp-link-function)
@@ -12892,7 +12892,7 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
 				     'face 'org-warning))))
 				     'face 'org-warning))))
 	      (message "%s => %s" cmd (eval (read cmd)))
 	      (message "%s => %s" cmd (eval (read cmd)))
 	    (error "Abort"))))
 	    (error "Abort"))))
-       
+
        (t
        (t
 	(browse-url-at-point)))))
 	(browse-url-at-point)))))
   (move-marker org-open-link-marker nil))
   (move-marker org-open-link-marker nil))
@@ -17431,15 +17431,24 @@ printf       a printf format for computed values"
 
 
 ;;; Dynamic block for Column view
 ;;; Dynamic block for Column view
 
 
-(defun org-columns-capture-view ()
-  "Get the column view of the current buffer and return it as a list.
-The list will contains the title row and all other rows.  Each row is
-a list of fields."
+(defun org-columns-capture-view (&optional maxlevel skip-empty-rows)
+  "Get the column view of the current buffer or subtree.
+The first optional argument MAXLEVEL sets the level limit.  A
+second optional argument SKIP-EMPTY-ROWS tells whether to skip
+empty rows, an empty row being one where all the column view
+specifiers except ITEM are empty.  This function returns a list
+containing the title row and all other rows.  Each row is a list
+of fields."
   (save-excursion
   (save-excursion
     (let* ((title (mapcar 'cadr org-columns-current-fmt-compiled))
     (let* ((title (mapcar 'cadr org-columns-current-fmt-compiled))
 	   (n (length title)) row tbl)
 	   (n (length title)) row tbl)
       (goto-char (point-min))
       (goto-char (point-min))
-      (while (re-search-forward "^\\*+ " nil t)
+      (while (and (re-search-forward "^\\(\\*+\\) " nil t)
+		  (or (null maxlevel)
+		      (>= maxlevel
+			  (if org-odd-levels-only
+			      (/ (1+ (length (match-string 1))) 2)
+			    (length (match-string 1))))))
 	(when (get-char-property (match-beginning 0) 'org-columns-key)
 	(when (get-char-property (match-beginning 0) 'org-columns-key)
 	  (setq row nil)
 	  (setq row nil)
 	  (loop for i from 0 to (1- n) do
 	  (loop for i from 0 to (1- n) do
@@ -17448,7 +17457,9 @@ a list of fields."
 			  "")
 			  "")
 		      row))
 		      row))
 	  (setq row (nreverse row))
 	  (setq row (nreverse row))
-	  (push row tbl)))
+	  (unless (and skip-empty-rows
+		       (eq 1 (length (delete "" (delete-dups row)))))
+	    (push row tbl))))
       (append (list title 'hline) (nreverse tbl)))))
       (append (list title 'hline) (nreverse tbl)))))
 
 
 (defun org-dblock-write:columnview (params)
 (defun org-dblock-write:columnview (params)
@@ -17463,10 +17474,15 @@ PARAMS is a property list of parameters:
           to column view).
           to column view).
 :hlines   When t, insert a hline before each item.  When a number, insert
 :hlines   When t, insert a hline before each item.  When a number, insert
           a hline before each level <= that number.
           a hline before each level <= that number.
-:vlines   When t, make each column a colgroup to enforce vertical lines."
+:vlines   When t, make each column a colgroup to enforce vertical lines.
+:maxlevel When set to a number, don't capture headlines below this level.
+:skip-empty-rows
+          When t, skip rows where all specifiers other than ITEM are empty."
   (let ((pos (move-marker (make-marker) (point)))
   (let ((pos (move-marker (make-marker) (point)))
 	(hlines (plist-get params :hlines))
 	(hlines (plist-get params :hlines))
 	(vlines (plist-get params :vlines))
 	(vlines (plist-get params :vlines))
+	(maxlevel (plist-get params :maxlevel))
+	(skip-empty-rows (plist-get params :skip-empty-rows))
 	tbl id idpos nfields tmp)
 	tbl id idpos nfields tmp)
     (save-excursion
     (save-excursion
       (save-restriction
       (save-restriction
@@ -17478,7 +17494,7 @@ PARAMS is a property list of parameters:
 		 (goto-char idpos))
 		 (goto-char idpos))
 		(t (error "Cannot find entry with :ID: %s" id))))
 		(t (error "Cannot find entry with :ID: %s" id))))
 	(org-columns)
 	(org-columns)
-	(setq tbl (org-columns-capture-view))
+	(setq tbl (org-columns-capture-view maxlevel skip-empty-rows))
 	(setq nfields (length (car tbl)))
 	(setq nfields (length (car tbl)))
 	(org-columns-quit)))
 	(org-columns-quit)))
     (goto-char pos)
     (goto-char pos)
@@ -19831,7 +19847,7 @@ t   List of all TODO entries            T   Entries with special TODO kwd
 m   Match a TAGS query                  M   Like m, but only TODO entries
 m   Match a TAGS query                  M   Like m, but only TODO entries
 L   Timeline for current buffer         #   List stuck projects (!=configure)
 L   Timeline for current buffer         #   List stuck projects (!=configure)
 s   Search for keywords                 C   Configure custom agenda commands
 s   Search for keywords                 C   Configure custom agenda commands
-/   Multi-occur 
+/   Multi-occur
 ")
 ")
 			(start 0))
 			(start 0))
 		    (while (string-match
 		    (while (string-match

+ 10 - 4
org.texi

@@ -3774,8 +3774,8 @@ values.
 
 
 The first column, @samp{%25ITEM}, means the first 25 characters of the
 The first column, @samp{%25ITEM}, means the first 25 characters of the
 item itself, i.e. of the headline.  You probably always should start the
 item itself, i.e. of the headline.  You probably always should start the
-column definition with the ITEM specifier.  The other specifiers create
-columns @samp{Owner} with a list of names as allowed values, for
+column definition with the @samp{ITEM} specifier.  The other specifiers
+create columns @samp{Owner} with a list of names as allowed values, for
 @samp{Status} with four different possible values, and for a checkbox
 @samp{Status} with four different possible values, and for a checkbox
 field @samp{Approved}.  When no width is given after the @samp{%}
 field @samp{Approved}.  When no width is given after the @samp{%}
 character, the column will be exactly as wide as it needs to be in order
 character, the column will be exactly as wide as it needs to be in order
@@ -3859,8 +3859,8 @@ Delete the current column.
 
 
 Since column view is just an overlay over a buffer, it cannot be
 Since column view is just an overlay over a buffer, it cannot be
 exported or printed directly.  If you want to capture a column view, use
 exported or printed directly.  If you want to capture a column view, use
-the dynamic block (@pxref{Dynamic blocks}).  The frame of this block
-looks like this:
+ths @code{columnview} dynamic block (@pxref{Dynamic blocks}).  The frame
+of this block looks like this:
 
 
 @example
 @example
 * The column view
 * The column view
@@ -3888,6 +3888,12 @@ When @code{t}, insert a hline after every line.  When a number N, insert
 a hline before each headline with level @code{<= N}.
 a hline before each headline with level @code{<= N}.
 @item :vlines
 @item :vlines
 When set to @code{t}, enforce column groups to get vertical lines.
 When set to @code{t}, enforce column groups to get vertical lines.
+@item :maxlevel
+When set to a number, don't capture entries below this level.
+@item :skip-empty-rows
+When set to @code{t}, skip row where the only non-empty specifier of the
+column view is @code{ITEM}.
+
 @end table
 @end table
 
 
 @noindent
 @noindent