From: Anders Waldenborg <andersg@0x63.nu>
To: Bastien <bastien.guerry@wikimedia.fr>
Cc: emacs-orgmode@gnu.org
Subject: Re: [Orgmode] Deriving mode from org-mode
Date: Fri, 15 Jul 2011 21:50:53 +0200 [thread overview]
Message-ID: <20110715195053.GA5700@0x63.nu> (raw)
In-Reply-To: <8762scuw0s.fsf@gnu.org>
[-- Attachment #1: Type: text/plain, Size: 413 bytes --]
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
[-- Attachment #2: aw-org-pw.el --]
[-- Type: text/plain, Size: 10106 bytes --]
;;;; aw-org-pw.el --- personal wiki major mode derived from org-mode.
;;
;; Copyright (C) 2011 Anders Waldenborg
;;
;; Author: Anders Waldenborg <anders@0x63.nu>
;; 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
prev parent reply other threads:[~2011-07-15 19:54 UTC|newest]
Thread overview: 8+ messages / expand[flat|nested] mbox.gz Atom feed top
2011-02-13 21:23 Deriving mode from org-mode Anders Waldenborg
2011-02-15 4:11 ` Bastien
2011-02-22 9:17 ` Anders Waldenborg
2011-02-22 9:21 ` Carsten Dominik
2011-02-22 9:34 ` Carsten Dominik
2011-02-22 21:31 ` Anders Waldenborg
2011-02-22 11:52 ` Bastien
2011-07-15 19:50 ` Anders Waldenborg [this message]
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20110715195053.GA5700@0x63.nu \
--to=andersg@0x63.nu \
--cc=bastien.guerry@wikimedia.fr \
--cc=emacs-orgmode@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.