From mboxrd@z Thu Jan 1 00:00:00 1970 From: Manuel Giraud Subject: [Patch 2/2] org-publish Date: Wed, 01 Dec 2010 11:11:56 +0100 Message-ID: <87ipzd7qfn.fsf@univ-nantes.fr> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from [140.186.70.92] (port=52572 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1PNjfQ-0004BR-LX for emacs-orgmode@gnu.org; Wed, 01 Dec 2010 05:12:07 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1PNjfL-0002qq-GL for emacs-orgmode@gnu.org; Wed, 01 Dec 2010 05:12:04 -0500 Received: from smtp-tls1.univ-nantes.fr ([193.52.101.145]:36992 helo=smtp-tls.univ-nantes.fr) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1PNjfL-0002p8-85 for emacs-orgmode@gnu.org; Wed, 01 Dec 2010 05:11:59 -0500 Received: from localhost (debian [127.0.0.1]) by smtp-tls.univ-nantes.fr (Postfix) with ESMTP id 4EFC195405 for ; Wed, 1 Dec 2010 11:11:57 +0100 (CET) Received: from smtp-tls.univ-nantes.fr ([127.0.0.1]) by localhost (smtp-tls1.d101.univ-nantes.fr [127.0.0.1]) (amavisd-new, port 10024) with LMTP id S0Xz8U2CBfhi for ; Wed, 1 Dec 2010 11:11:57 +0100 (CET) Received: from K (unknown [172.16.13.134]) (using TLSv1 with cipher DHE-RSA-AES128-SHA (128/128 bits)) (No client certificate requested) by smtp-tls.univ-nantes.fr (Postfix) with ESMTPSA id 38CE395401 for ; Wed, 1 Dec 2010 11:11:57 +0100 (CET) List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Sender: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org To: emacs-orgmode --=-=-= This second patch (that should be applied after the first one) adds a formating option to sitemap entries. One can now use a formated string to generate a sitemap entry. This formated string currently understands title (%T), author (%A) and date (%D). --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=formated-sitemap.patch diff --git a/lisp/org-publish.el b/lisp/org-publish.el index 296921f..ec58af0 100644 --- a/lisp/org-publish.el +++ b/lisp/org-publish.el @@ -267,6 +267,22 @@ You can overwrite this default per project in your :group 'org-publish :type 'boolean) +(defcustom org-publish-sitemap-date-format "%Y-%m-%d" + "Format for `format-time-string' which is used to print a date +in the sitemap." + :group 'org-publish + :type 'string) + +(defcustom org-publish-sitemap-file-entry-format "[%T]" + "How a sitemap file entry is formated. +Watch out the text used for the link should between brackets. + +%T is the title. +%A is the author. +%D is the date formated using `org-publish-sitemap-date-format'." + :group 'org-publish + :type 'string) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Timestamp-related functions @@ -370,6 +386,8 @@ This splices all the components into the list." (defvar sitemap-sort-folders) (defvar sitemap-ignore-case) (defvar sitemap-requested) +(defvar sitemap-date-format) +(defvar sitemap-file-entry-format) (defun org-publish-compare-directory-files (a b) "Predicate for `sort', that sorts folders and files for sitemap." (let ((retval t)) @@ -392,8 +410,10 @@ This splices all the components into the list." (not (string-lessp B A)))))) ((or (equal sitemap-sort-files 'chronologically) (equal sitemap-sort-files 'anti-chronologically)) - (let ((A (org-publish-find-date a)) - (B (org-publish-find-date b))) + (let* ((adate (org-publish-find-date a)) + (bdate (org-publish-find-date b)) + (A (+ (lsh (car adate) 16) (cadr adate))) + (B (+ (lsh (car bdate) 16) (cadr bdate)))) (setq retval (if (equal sitemap-sort-files 'chronologically) (<= A B) (>= A B))))))) @@ -695,6 +715,10 @@ If :makeindex is set, also produce a file theindex.org." "sitemap.org")) (sitemap-function (or (plist-get project-plist :sitemap-function) 'org-publish-org-sitemap)) + (sitemap-date-format (or (plist-get project-plist :sitemap-date-format) + org-publish-sitemap-date-format)) + (sitemap-file-entry-format (or (plist-get project-plist :sitemap-file-entry-format) + org-publish-sitemap-file-entry-format)) (preparation-function (plist-get project-plist :preparation-function)) (completion-function (plist-get project-plist :completion-function)) (files (org-publish-get-base-files project exclude-regexp)) file) @@ -770,12 +794,27 @@ Default for SITEMAP-FILENAME is 'sitemap.org'." (setq indent-str (make-string (+ (length indent-str) 2) ?\ ))))))) ;; This is common to 'flat and 'tree - (insert (concat indent-str " + [[file:" link "][" - (org-publish-find-title file) - "]]\n"))))) + (let ((entry + (org-publish-format-file-entry sitemap-file-entry-format + file project-plist)) + (regexp "\\(.*\\)\\[\\([^][]+\\)\\]\\(.*\\)")) + (string-match regexp entry) + (insert (concat indent-str " + " (match-string 1 entry) + "[[file:" link "][" + (match-string 2 entry) + "]]" (match-string 3 entry) "\n")))))) (save-buffer)) (or visiting (kill-buffer sitemap-buffer)))) +(defun org-publish-format-file-entry (fmt file project-plist) + (org-replace-escapes fmt + (list (cons "%T" (org-publish-find-title file)) + (cons "%D" (format-time-string + sitemap-date-format + (org-publish-find-date file))) + (cons "%A" (or (plist-get project-plist :author) + user-full-name))))) + (defun org-publish-find-title (file) "Find the title of FILE in project." (or @@ -800,7 +839,9 @@ Default for SITEMAP-FILENAME is 'sitemap.org'." (defun org-publish-find-date (file) "Find the date of FILE in project. If FILE provides a #+date keyword use it else use the file -system's modification time." +system's modification time. + +It returns time in `current-time' format." (let ((visiting (find-buffer-visiting file))) (save-excursion (switch-to-buffer (or visiting (find-file file))) @@ -809,10 +850,9 @@ system's modification time." (unless visiting (kill-buffer (current-buffer))) (if date - (let ((dt (org-time-string-to-time date))) - (+ (lsh (car dt) 16) (cadr dt))) + (org-time-string-to-time date) (when (file-exists-p file) - (org-publish-cache-ctime-of-src file))))))) + (nth 5 (file-attributes file)))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Interactive publishing functions --=-=-= -- Manuel Giraud --=-=-= Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Disposition: inline _______________________________________________ Emacs-orgmode mailing list Please use `Reply All' to send replies to the list. Emacs-orgmode@gnu.org http://lists.gnu.org/mailman/listinfo/emacs-orgmode --=-=-=--