From mboxrd@z Thu Jan 1 00:00:00 1970 From: Anders Waldenborg Subject: Re: [Orgmode] Deriving mode from org-mode Date: Fri, 15 Jul 2011 21:50:53 +0200 Message-ID: <20110715195053.GA5700@0x63.nu> References: <4D584BE5.2050401@0x63.nu> <877hd2q6mx.fsf@gnu.org> <4D637F12.3050906@0x63.nu> <8762scuw0s.fsf@gnu.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="bg08WKrSYDhXBjb5" Return-path: Received: from eggs.gnu.org ([140.186.70.92]:50992) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1QhoSr-0001zv-71 for emacs-orgmode@gnu.org; Fri, 15 Jul 2011 15:54:26 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1QhoSm-0005ca-FZ for emacs-orgmode@gnu.org; Fri, 15 Jul 2011 15:54:20 -0400 Received: from 0x63.nu ([193.26.17.18]:55091 helo=gagarin.0x63.nu) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1QhoSk-0005bj-Cu for emacs-orgmode@gnu.org; Fri, 15 Jul 2011 15:54:14 -0400 Content-Disposition: inline In-Reply-To: <8762scuw0s.fsf@gnu.org> 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-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org To: Bastien Cc: emacs-orgmode@gnu.org --bg08WKrSYDhXBjb5 Content-Type: text/plain; charset=us-ascii Content-Disposition: inline On Tue, Feb 22, 2011 at 12:52:03PM +0100, Bastien wrote: > > It is a "personal wiki" mode. It automatically narrows to current top level > > heading, adds some extra navigation functions and allows creating links to > > new "pages" (= top level heading) in a simple way. Hopefully I can clean it > > up a little bit soon and publish it. > > That'd be great, thanks! Here it is, after a "slight" delay. anders --bg08WKrSYDhXBjb5 Content-Type: text/plain; charset=us-ascii Content-Disposition: attachment; filename="aw-org-pw.el" ;;;; aw-org-pw.el --- personal wiki major mode derived from org-mode. ;; ;; Copyright (C) 2011 Anders Waldenborg ;; ;; Author: Anders Waldenborg ;; Keywords: outlines, calendar, wp ;; Version: 0.1 ;; ;; This file NOT is part of GNU Emacs. ;; ;; 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 `http://www.gnu.org/licenses/'. ;; ;; ;;; Commentary: ;; ;; This implements the following features on top of org-mode making it ;; feel more like a (personal) wiki: ;; ;; * Auto narrowing to current section (= first level heading). ;; * Linking of all section names. ;; * Creating of new sections when following nonexistant links. ;; * Recording navigation history and back functionality. ;; ;; ;;; Code: (require 'org) (defconst aw-org-pw-frontpage-name "StartPage" "Fake name created for the section before first heading") ;;;; ;;;; Random helper functions ;;;; (defun aw-truncate-list (l n) "Destructivly truncates list l to n elements" (let ((e (nthcdr (1- n) l))) (when e (setcdr e nil))) l) (defun aw-org-pw-word-at-point () "Return word at point, or currently marked text if mark is active" (interactive) (if mark-active (buffer-substring-no-properties (point) (mark)) (when (looking-at "\\w") (let ((start (save-excursion (while (not (looking-at "\\b\\w")) (backward-char)) (point))) (end (save-excursion (while (not (looking-at "\\w\\b")) (forward-char)) (1+ (point))))) (buffer-substring-no-properties start end))))) ;;;; ;;;; Section navigation ;;;; (defun aw-org-pw-section-regexp (&optional pagename) "Return a regexp matching page section (or any section if pagename is nil)" (format "^\\* *\\(%s\\)$" (if pagename (regexp-quote pagename) "[^*].*"))) (defun aw-org-pw-get-section-region (name) "Find (start . end) points of specified section" (let ((case-fold-search t) (search (aw-org-pw-section-regexp name))) (save-excursion (save-restriction (widen) (goto-char (point-min)) (aw-org-pw-next-section) (if (string-equal name aw-org-pw-frontpage-name) (cons (point-min) (point)) (while (not (looking-at search)) (forward-line) (aw-org-pw-next-section) (if (eobp) (error "Section not found"))) (forward-line) (let ((start (point))) (aw-org-pw-next-section) (cons start (point)))))))) (defun aw-org-pw-all-sections () "Return a list with all section names" (save-restriction (save-excursion (widen) (let ((res (list aw-org-pw-frontpage-name)) (re (aw-org-pw-section-regexp))) (goto-char (point-min)) (while (not (eobp)) (when (looking-at re) (setq res (cons (match-string-no-properties 1) res))) (forward-line)) res)))) (defun aw-org-pw-next-section () "Go to next section" (let ((re (aw-org-pw-section-regexp))) (while (not (or (eobp) (looking-at re))) (forward-line)) (point))) (defun aw-org-pw-current-section-name () "Find current section name This is usually same as the variable aw-org-pw-current-section, but if navigation has happened by other means (e.g isearch) this function may be needed to get the correct value." (save-restriction (save-excursion (widen) (let ((re (aw-org-pw-section-regexp))) (while (not (or (bobp) (looking-at re))) (forward-line -1)) (if (bobp) aw-org-pw-frontpage-name (match-string-no-properties 1)))))) ;;;; ;;;; Navigation with history ;;;; (defun aw-org-pw-back () "Goto previously visited section" (interactive) (unless aw-org-pw-breadcrumbs-list (error "Nowhere to go I think...")) (let ((f (pop aw-org-pw-breadcrumbs-list))) (aw-org-pw-goto-section-raw (car f)) (setq aw-org-pw-current-section (car f)) (goto-char (+ (point-min) (cdr f))))) (defun aw-org-pw-goto-section-raw (name) "Go to specified section without updating history" (let ((reg (aw-org-pw-get-section-region name))) (narrow-to-region (car reg) (cdr reg)))) (defun aw-org-pw-goto-section-with-history (name offset prevsec) "Go to specified section recording provided history" (aw-org-pw-goto-section-raw name) (push (cons prevsec offset) aw-org-pw-breadcrumbs-list) (aw-truncate-list aw-org-pw-breadcrumbs-list 10) (setq aw-org-pw-current-section name) (goto-char (point-min))) (defun aw-org-pw-goto-section (name) "Go to specified section" (aw-org-pw-goto-section-with-history name (- (point) (point-min)) aw-org-pw-current-section)) (defun aw-org-pw-frontpage () "Navigate to front page" (interactive) (aw-org-pw-goto-section aw-org-pw-frontpage-name)) ;;;; ;;;; Links ;;;; (defun aw-org-pw-follow-link-at-point () "" (interactive) (cond ;; aw-org-pw link -> aw-org-pw-goto-section ((get-text-property (point) 'aw-org-pw-linked-text) (aw-org-pw-goto-section (get-text-property (point) 'aw-org-pw-linked-text))) ;; other kind of org link -> org-open-at-point ((eq (get-text-property (point) 'face) 'org-link) (org-open-at-point)) ;; not a link? -> offer to create page ((aw-org-pw-word-at-point) (aw-org-pw-create-new-section t)) ;; bail out (t (message "Don't know what to do")))) (defun aw-org-pw-follow-link-at-mouse (ev) "Follow link at mouse" (interactive "e") (mouse-set-point ev) (aw-org-pw-follow-link-at-point)) (defun aw-org-pw-create-new-section (&optional confirm) "Create a new section in current file" (let ((pagename (aw-org-pw-word-at-point))) (if (and confirm (not (y-or-n-p (format "Create new page '%s'? " pagename)))) (message "Page creation aborted") (widen) (goto-char (point-max)) (insert "\n\n* " pagename "\n") (aw-org-pw-update-sections-regexp) (aw-org-pw-goto-section pagename)))) ;;;; ;;;; Link hilighting ;;;; (defun aw-org-pw-activate-links (limit) "" (when (derived-mode-p 'aw-org-pw-mode) (let ((case-fold-search t)) (when (re-search-forward aw-org-pw-link-regexp limit t) (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) (add-text-properties (match-beginning 0) (match-end 0) (list 'mouse-face 'highlight 'keymap aw-org-pw-link-map 'help-echo "Personal wiki link" 'aw-org-pw-linked-text (match-string-no-properties 0))) (org-rear-nonsticky-at (match-end 0)) t)))) (add-hook 'org-font-lock-set-keywords-hook (lambda () (add-to-list 'org-font-lock-extra-keywords '(aw-org-pw-activate-links (0 'org-link t)) t))) (defun aw-org-pw-update-sections-regexp () "Update regexp used to create all section-links" (setq aw-org-pw-link-regexp (regexp-opt (aw-org-pw-all-sections) 'words))) ;;;; ;;;; isearch integration - widen before search starts, and narrow when ;;;; done, possibly updating breadcrumbs. ;;;; (defvar aw-org-pw-isearch-startoff nil "Internal variable for storing offset in page when search starts") (defun aw-org-pw-isearch-start () (setq aw-org-pw-isearch-startoff (- (point) (point-min))) (widen)) (defun aw-org-pw-isearch-end () (if isearch-mode-end-hook-quit (aw-org-pw-goto-section-raw aw-org-pw-current-section) (save-excursion (aw-org-pw-goto-section-with-history (aw-org-pw-current-section-name) aw-org-pw-isearch-startoff aw-org-pw-current-section)))) ;;;; ;;;; imenu integration ;;;; (defun aw-org-pw-imenu-entries () (mapcar (lambda (e) (cons e 1)) (aw-org-pw-all-sections))) (defun aw-org-pw-imenu-goto (name pos &optional rest) (aw-org-pw-goto-section name)) ;;;; ;;;; Avoid creating top level headers ;;;; (defun aw-org-star () "Insert two (on beginning of line) or one (otherwise) '*' characters This works mostly as a reminder that first level headings are special in aw-org-pw-mode and should not be created manually." (interactive) (if (bolp) (insert "**") (insert "*"))) ;;;; ;;;; Actual mode definition ;;;; (define-derived-mode aw-org-pw-mode org-mode "Org-PW" nil (make-local-variable 'aw-org-pw-breadcrumbs-list) (make-local-variable 'aw-org-pw-current-section) (setq aw-org-pw-breadcrumbs-list nil) (setq aw-org-pw-current-section "none") (setq header-line-format '("[" aw-org-pw-current-section "] back:" (:eval (if aw-org-pw-breadcrumbs-list (caar aw-org-pw-breadcrumbs-list) "no history")))) (setq imenu-create-index-function 'aw-org-pw-imenu-entries) (setq imenu-default-goto-function 'aw-org-pw-imenu-goto) (add-hook 'isearch-mode-hook 'aw-org-pw-isearch-start nil t) (add-hook 'isearch-mode-end-hook 'aw-org-pw-isearch-end nil t) (widen) (show-all) (aw-org-pw-update-sections-regexp) (aw-org-pw-frontpage)) ;;;; ;;;; Keymaps ;;;; (define-key aw-org-pw-mode-map "\C-c\C-o" 'aw-org-pw-follow-link-at-point) (define-key aw-org-pw-mode-map "\C-c\C-b" 'aw-org-pw-back) (define-key aw-org-pw-mode-map "\C-c\C-f" 'aw-org-pw-frontpage) (define-key aw-org-pw-mode-map "*" 'aw-org-star) (defvar aw-org-pw-link-map (make-sparse-keymap)) (define-key aw-org-pw-link-map [mouse-2] 'aw-org-pw-follow-link-at-mouse) (when org-mouse-1-follows-link (define-key aw-org-pw-link-map [follow-link] 'mouse-face)) (define-key aw-org-pw-link-map [return] 'aw-org-pw-follow-link-at-point) (provide 'aw-org-pw) ;;; aw-org-pw.el ends here --bg08WKrSYDhXBjb5--