From mboxrd@z Thu Jan 1 00:00:00 1970 From: Nicolas Goaziou Subject: Re: Display-level automatic subtree numbering Date: Thu, 01 Nov 2018 18:49:07 +0100 Message-ID: <87zhusbsdo.fsf@nicolasgoaziou.fr> References: <87r2ggjz45.fsf@portable.galex-713.eu> <87bm7kjv01.fsf@portable.galex-713.eu> <87h8hbyeu5.fsf@nicolasgoaziou.fr> <874ldbhggz.fsf@portable.galex-713.eu> <878t2ny3mp.fsf@nicolasgoaziou.fr> <874ldbef9v.fsf@portable.galex-713.eu> <8736sugjc5.fsf@nicolasgoaziou.fr> <8736srggq3.fsf@portable.galex-713.eu> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:45677) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1gIH5p-00015s-2Z for emacs-orgmode@gnu.org; Thu, 01 Nov 2018 13:49:18 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1gIH5l-0001K6-1p for emacs-orgmode@gnu.org; Thu, 01 Nov 2018 13:49:17 -0400 Received: from relay6-d.mail.gandi.net ([217.70.183.198]:60573) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1gIH5k-0001IF-I8 for emacs-orgmode@gnu.org; Thu, 01 Nov 2018 13:49:12 -0400 In-Reply-To: <8736srggq3.fsf@portable.galex-713.eu> (Alexandre Garreau's message of "Sun, 28 Oct 2018 00:36:04 +0200") List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Sender: "Emacs-orgmode" To: "Garreau, Alexandre" Cc: org-mode-email , John Kitchin --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hello, "Garreau, Alexandre" writes: > No it doesn=E2=80=99t update anything, and doesn=E2=80=99t color number c= ompatibly with > outlining. Also it=E2=80=99s not integrated in org and only available in= melpa, > unsigned. As I was offline for a few days, I toyed a bit with this. I wrote the following library. I didn't test it thoroughly. I didn't write regression tests either. Also, it ignores UNNUMBERED property and export tags. I have the feeling these are orthogonal requirements (i.e., if you want to see the numbering obtained upon export, just export your document). You may want to test it. It could go in GNU ELPA or some such if fast and accurate enough. Regards, --=20 Nicolas Goaziou --=-=-= Content-Type: application/emacs-lisp Content-Disposition: attachment; filename=org-num.el Content-Transfer-Encoding: quoted-printable Content-Description: Dynamic headline numbering in Org ;;; org-num.el --- Dynamic Headlines Numbering -*- lexical-binding: t; -*- ;; Copyright (C) 2018 Free Software Foundation, Inc. ;; Author: Nicolas Goaziou ;; Keywords: outlines, hypermedia, calendar, wp ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; This library provides dynamic numbering for Org headlines. Use ;; ;; ;; ;; to toggle it. ;; ;; Numbering ignores UNNUMBERED properties and export tags ;; (e.g. :noexport:) and focuses on actual numbers instead. ;; ;; Internally, the library handles an ordered list, per buffer ;; position, of overlays in `org-num--overlays'. ;; Overlays store the numbering in the `numbering' property. ;; A numbering is represented as a list of integers in reverse order. ;; So numbering for headline "1.2.3" is '(3 2 1). ;; ;; Display is done through the `after-string' property. An overlay ;; with a nil `after-string' property is called an invalid overlay. ;; It serves as a marker to trigger re-parsing on a part of the ;; buffer. Modified overlays automatically become invalid overlays. ;;; Code: (require 'cl-lib) (require 'org-macs) ;;; Internal Variables (defvar-local org-num--overlays nil "Ordered list of overlays used for numbering outlines.") ;;; Internal Functions (defun org-num--make-overlay (numbers &optional invalid) "Return overlay for numbering headline at point. NUMBERS is the numbering to use, as a list of integers. When optional argument INVALID is non-nil, return an invalid overlay, per `org-num--valid-overlay-p'. Assume point is at a headline." (let ((after-edit-functions (list (lambda (o &rest _) ;; Invalidate overlay. (overlay-put o 'after-string nil)))) (o (save-excursion (beginning-of-line) (skip-chars-forward "\\*") (make-overlay (line-beginning-position) (1+ (point)))))) (unless invalid (org-num--refresh-overlay o numbers)) (overlay-put o 'modification-hooks after-edit-functions) (overlay-put o 'insert-in-front-hooks after-edit-functions) o)) (defun org-num--refresh-overlay (overlay numbering) "Refresh numbering for OVERLAY. NUMBERING specifies the new numbering, as a list of integers. Assume OVERLAY is still active in the buffer. Return modified overlay." (when numbering (overlay-put overlay 'numbering numbering) (let ((suffix (concat (mapconcat #'number-to-string (reverse numbering)= ".") " "))) (overlay-put overlay 'after-string suffix))) overlay) (defun org-num--follow-overlay (overlay last) "Make OVERLAY's numbering follow LAST's. OVERLAY is a valid numbering overlay in the current buffer. LAST is either a numbering overlay or nil. Return modified OVERLAY." (let ((level (length (overlay-get overlay 'numbering))) (last-numbering (and last (overlay-get last 'numbering)))) (org-num--refresh-overlay overlay (org-num--next-number last-numbering level)))) (defsubst org-num--valid-overlay-p (o) "Non-nil if overlay O is still active in the buffer." (overlay-get o 'after-string)) (defun org-num--next-number (previous level) "Return numbering following PREVIOUS, at LEVEL. PREVIOUS is a numbering. LEVEL is the level of the new numbering." (let ((previous-level (length previous))) (cond ;; (1 3) =3D> (2 3) ((=3D level previous-level) (cons (1+ (car previous)) (cdr previous))) ;; (1 3) =3D> (4) ((< level previous-level) (let ((suffix (nthcdr (- previous-level level) previous))) (cons (1+ (car suffix)) (cdr suffix)))) ;; (1 3) =3D> (1 1 3) (t (append (cons 1 (make-list (- level previous-level 1) 0)) previous))))) (defun org-num--number-region (start end last) "Add numbering overlays between BEG and END. LAST is the numbering for the headline at START, as a list of integers, or nil if there is no headline. Narrowing, if any, is ignored. Return the list of created overlays, newest first." (org-with-point-at (or start 1) ;; Do not match headline at START again. (when start (end-of-line)) (let ((regexp (org-with-limited-levels org-outline-regexp-bol)) (new nil)) (save-match-data (while (re-search-forward regexp end t) (let ((level (org-reduced-level (- (match-end 0) (match-beginning 0) 1)))) (setq last (org-num--next-number last level)) ;; Apply numbering to current headline. Store overlay for ;; the return value. (push (org-num--make-overlay last) new))) new)))) (defun org-num--repair-overlays () "Repair the numbering overlays list. This function removes invalid overlays and refreshes numbering for the valid ones in the numbering overlays list. It also adds missing overlays to that list." (let ((new-overlays nil) (overlay nil) (last nil)) (while (setq overlay (pop org-num--overlays)) (cond ;; Valid overlay. Update its numbering according to the last ;; known overlay. ((org-num--valid-overlay-p overlay) (push (org-num--follow-overlay overlay last) new-overlays) (setq last overlay)) ;; Invalid overlay. This is an indication that the buffer needs ;; to be parsed again between two surrounding valid overlays or ;; buffer boundaries. (t ;; Ignore consecutive invalid overlays since we re-create all ;; overlays between last valid overlay and the next one. (let ((invalid (list (overlay-start overlay)))) (while (and org-num--overlays (not (org-num--valid-overlay-p (car org-num--overlays= )))) (push (overlay-start (pop org-num--overlays)) invalid)) ;; Register new overlays. (let ((last-start (and last (overlay-start last))) (next-start (and org-num--overlays (overlay-start (car org-num--overlays))))) (when (delq last-start (delq next-start invalid)) (setq new-overlays (nconc (org-num--number-region last-start next-start (and last (overlay-get last 'numbering))) new-overlays))))) ;; Last valid overlay is the last created overlay. (setq last (car new-overlays))))) (setq org-num--overlays (nreverse new-overlays)))) (defun org-num--update (beg end _) "Update numbering after a buffer modification. This function is meant to be used in `after-change-functions'. See" (let ((starts (mapcar #'overlay-start org-num--overlays)) (regexp (org-with-limited-levels org-outline-regexp-bol))) ;; Check if we created any headline. (cond ;; Deletion. There are two ways to create a brand new headline: ;; either remove the characters at the beginning of a line while ;; the rest of it looks like a headline, or remove a newline ;; character between stars at the beginning of a line and ;; a space. E.g., ;; ;; X|* Headline =3D> |* Headline ;; ;; or, ;; ;; *\n| Headline =3D> *| Headline ;; ;; Any other combination alters an existing headline to create ;; the new one, and therefore leaves an invalid overlay in ;; `org-num--overlays'. ((=3D beg end) (org-with-point-at beg (when (and (progn (skip-chars-backward "*") (looking-at-p regexp)) (not (memq (line-beginning-position) starts))) ;; Insert a placeholder at the appropriate location in ;; sorted list `org-num--overlays', i.e., before the first ;; overlay starting after BEG, or at the end of the list ;; otherwise. (let ((i (cl-position (line-beginning-position) starts :test #'<)= )) (push (org-num--make-overlay nil t) (nthcdr (or i (length starts)) org-num--overlays)))))) ;; Insertion. Check if we created a headline between BEG and ;; END. Actually extend search to the beginning of line before ;; BEG to cover, e.g., these kinds of situation: ;; ;; *|bold* =3D> * |bold* ;; ;; Also extend to the end of line after END to cover, e.g., ;; ;; X| H =3D> X\n*| H ;; ;; When we find a new headline, simply add an invalid a single ;; invalid overlay at the appropriate location in the overlays' ;; list. The function `org-num--repair-overlays' will take care ;; of finding and numbering all of them. (t (org-with-point-at beg ;; If insertion starts on an existing headline, skip it. (if (memq (line-beginning-position) starts) (end-of-line) (beginning-of-line)) ;; Likewise, if insertion ends on an existing headline, skip ;; it. (let ((end (max (point) (save-excursion (goto-char end) (if (memq (line-beginning-position) starts) (line-beginning-position) (line-end-position)))))) (when (save-match-data (re-search-forward regexp end t)) (let ((i (or (cl-position beg starts :test #'<) (length starts)))) (push (org-num--make-overlay nil t) (nthcdr i org-num--overlays)))))))) ;; Repair numbering only if a headline was altered or created. (unless (cl-every #'org-num--valid-overlay-p org-num--overlays) (org-num--repair-overlays)))) ;;; Public Function ;;;###autoload (define-minor-mode org-num-mode "Dynamic numbering of headlines in an Org buffer." :ligther " o#" (cond (org-num-mode (unless (derived-mode-p 'org-mode) (user-error "Cannot activate headline numbering outside Org mode")) (setq org-num--overlays (nreverse (org-num--number-region nil nil nil))) (add-hook 'after-change-functions #'org-num--update nil t)) (t (mapc #'delete-overlay org-num--overlays) (setq org-num--overlays nil) (remove-hook 'after-change-functions #'org-num--update t)))) (provide 'org-num) ;;; org-num.el ends here --=-=-=--