--- pukiwiki-mode.el.download-041005 2004-10-05 16:30:14.000000000 +0900 +++ pukiwiki-mode.el 2004-10-06 10:47:41.000000000 +0900 @@ -126,12 +126,41 @@ (defvar pukiwiki-bracket-name-regexp '("\\[\\[\\([^]:|]+\\)\\]\\]" . 1)) (defvar pukiwiki-rd+-bracket-name-regexp '("((<\\([^>:|]+\\)>))" . 1)) +;; regexp for anchor of alias. +(defvar pukiwiki-bracket-alias-regexp + '("\\[\\[\\([^]:|]+>+[^]:|]+\\)\\]\\]" . 1)) + +;; InterWikiName +;; regexp for anchor of InterWikiName and Alias. +(defvar pukiwiki-bracket-interwikiname-regexp + '("\\[\\[\\([^]:|]+>*[^]:|]+:+[^]:|]+\\)\\]\\]" . 1)) + +;; regexp for anchor of href. +(defvar pukiwiki-view-bracket-url-regexp + ;; '("\\[+\\(https*:[^]]+\\s-+[^]:|]+\\)\\]+" . 1)) + '("\\[+\\(\\(ht\\|f\\)tps*:[^]]+\\s-+[^]:|]+\\)\\]+" . 1)) +(defvar pukiwiki-view-bracket-url-secondhalf-regexp + ;; '("\\[+\\([^]]+:https*:[^]]+[^]:|]+\\)\\]+" . 1)) + '("\\[+\\([^]]+[>:]\\(ht\\|f\\)tps*:[^]]+[^]:|]+\\)\\]+" . 1)) + +;; regexp for anchor of href 2. +(defvar pukiwiki-view-no-bracket-url-regexp + '("\\(h*ttps*:[-+_a-zA-Z0-9/.,~#?&%=]+\\)" . 1)) + (defvar pukiwiki-style-anchor-regexp-alist (list (cons 'default (cons pukiwiki-bracket-name-regexp pukiwiki-wikiname-regexp-list)) - (cons 'rd+ (list pukiwiki-rd+-bracket-name-regexp))) + (cons 'rd+ (list pukiwiki-rd+-bracket-name-regexp)) + (cons 'delete-url-description + (list pukiwiki-view-bracket-url-regexp + pukiwiki-bracket-interwikiname-regexp + pukiwiki-bracket-alias-regexp + pukiwiki-view-bracket-url-secondhalf-regexp)) + (cons 'leave-url-description + (list pukiwiki-bracket-name-regexp + pukiwiki-view-no-bracket-url-regexp))) "Alist of regexp for anchor.") (defvar pukiwiki-anchor-regexp-alist @@ -141,6 +170,105 @@ (copy-face 'underline 'pukiwiki-anchor-face) "Face for Pukiwiki anchor." ) +(defcustom pukiwiki-no-proxy-domains-list '("localhost") + "*Domain list that don't via proxy server." + :group 'pukiwiki + :type '(repeat (string :format "Domain name: %v +" :size 0))) + +(defcustom pukiwiki-process-sentinel-interval 1 + "*Sentinel time for end of process." + :group 'pukiwiki + :type '(integer :size 0)) + +(defcustom pukiwiki-jump-display-window-top nil + "*Non-nil means displaying the pointer which moved at the top of a window." + :group 'pukiwiki + :type 'boolean) + +(defcustom pukiwiki-jump-display-window-top-without-content nil + "*Non-nil means excepting, if it is content +when displaying the pointer which moved at the top of a window." + :group 'pukiwiki + :type 'boolean) + +(defcustom pukiwiki-jump-display-window-top-skip-visible-url nil + "*Non-nil means ignore, if it is visible url description +when displaying the pointer which moved at the top of a window." + :group 'pukiwiki + :type 'boolean) + +(defcustom pukiwiki-jump-display-window-upper-margin 0 + "*The margin of the window upper part when displaying the pointer +which moved at the top of a window." + :group 'pukiwiki + :type '(integer :size 0)) + +(defcustom pukiwiki-jump-display-window-top-only-header nil + "*Non-nil means if it is header +when displaying the pointer which moved at the top of a window." + :group 'pukiwiki + :type 'boolean) + +(defcustom pukiwiki-diff-using-ediff nil + "*Non-nil means using `Ediff' package for diff process." + :group 'pukiwiki + :type 'boolean) + +(defcustom pukiwiki-view-comment-form-name-field-width 20 + "*Width of the NAME input field." + :group 'pukiwiki + :type '(integer :size 0)) + +(defcustom pukiwiki-view-comment-form-comment-field-width 60 + "*Width of the COMMENT input field." + :group 'pukiwiki + :type '(integer :size 0)) + +(defcustom pukiwiki-view-comment-form-subject-field-width 40 + "*Width of the COMMENT input field." + :group 'pukiwiki + :type '(integer :size 0)) + +(defcustom pukiwiki-view-comment-form-message-field-width 64 + "*Width of the COMMENT input field." + :group 'pukiwiki + :type '(integer :size 0)) + +(defcustom pukiwiki-view-comment-form-name-default nil + "*Default value of the NAME input field." + :group 'pukiwiki + :type '(radio (const :tag "Not specified" nil) + (string :format "Default post name: %v\n" :size 0))) + +(defcustom pukiwiki-interwiki-browse-not-match-pukiwiki nil + "*Non-nil means browse extent browser by browse-url, +url is not match PukiWiki site." + :group 'pukiwiki + :type 'boolean) + +(defcustom pukiwiki-view-jump-page-history-keep-count 100 + "*Maximum number of history which the HISTORY LIST keeps." + :group 'pukiwiki + :type '(integer :size 0)) + +(defcustom pukiwiki-view-form-textarea-buffer-history-keep-count 50 + "*Maximum number of history which the HISTORY LIST keeps." + :group 'pukiwiki + :type '(integer :size 0)) + +(defcustom pukiwiki-view-chip-away-bracket t + "*Non-nil means chip away bracket from anchor." + :group 'pukiwiki + :type 'boolean) + +(defcustom pukiwiki-view-comment-date-regexp + '("[0-9]+-[0-9]+-[0-9]+" "[0-9]+年[0-9]+月[0-9]+日") + "*Date pattern list of comment." + :group 'pukiwiki + :type '(repeat (string :format "regexp: %v +" :size 0))) + (defvar pukiwiki-keywords '("add" "aname" "article" "attach" "back" "backup" "bugtrack" "bugtrack_list" @@ -159,26 +287,32 @@ "touchgraph" "tracker" "unfreeze" "version" "versionlist" "vote" "yetlist")) +(setq pukiwiki-view-list-face 'pukiwiki-view-list-1-face) (defvar pukiwiki-font-lock-keywords (list - '("^[ ]*_ \\([0-9]+-[0-9]+-[0-9]+[ ]*([^)]+)[ ]*[0-9]+:[0-9]+:[0-9]+ \\[[^\r\n]+$\\)" 1 font-lock-comment-face) + (cons + (concat "^[ ]*\\(_\\|\\[[0-9* ]+\\]\\) \\(\\(" + (mapconcat 'identity pukiwiki-view-comment-date-regexp "\\|") + "\\)[ ]*([^)]+)[ ]*[0-9]+:[0-9]+:[0-9]+ *\\[*[^\r\n]+$\\)") + '((1 pukiwiki-view-button-face t t) + (2 pukiwiki-view-comment-header-face t t))) + '("\\(^//[^\n\r]+$\\)" 1 font-lock-comment-face) '("\\(^[>]+[^\n\r]+$\\)" 1 font-lock-reference-face) - ;; '("^\\([ ]*-+[^\n\r]+$\\)" 1 font-lock-keyword-face) (cons (concat "^#\\(" (mapconcat 'identity pukiwiki-keywords "\\|") "\\)") (list 0 'font-lock-keyword-face)) + ;***** (list 0 'font-lock-reference-face)) (cons (concat "^#\\(" (mapconcat 'identity pukiwiki-keywords "\\|") "\\)" "(\\([^\n\r]+\\))") (list 2 'font-lock-doc-face)) - '("\\(^[*]+[^\n\r]+\\)" 1 font-lock-function-name-face) - '("\\(^ [^\n\r]+$\\)" 1 font-lock-constant-face) - )) + '("\\(^[*]+[^\n\r]+\\)" 1 pukiwiki-view-header-face) + '("\\(^ [^\n\r]+$\\)" 1 pukiwiki-view-preformat-face-1))) (defface pukiwiki-added-face '((((class color) @@ -202,6 +336,140 @@ (defvar pukiwiki-added-face 'pukiwiki-added-face) (defvar pukiwiki-removed-face 'pukiwiki-removed-face) +;; view mode の face 定義。 +(defgroup pukiwiki-face nil + "The faces used for pukiwiki-mode." + :group 'pukiwiki + :prefix "pukiwiki-") + +(defface pukiwiki-view-header-face + '((((class color) (background light)) + (:foreground "BlueViolet" :background "Lavenderblush")) + (((class color) (background dark)) (:foreground "darkviolet"))) + "見出し行の face" + :group 'pukiwiki-face) + +(defface pukiwiki-view-comment-header-face + '((((class color) (background light)) (:foreground "seagreen")) + (((class color) (background dark)) (:foreground "seagreen"))) + "コメント見出し (日付、時刻と投稿者が表示される部分) の face" + :group 'pukiwiki-face) + +(defface pukiwiki-view-cite-face + '((((class color) (background light)) (:foreground "olivedrab")) + (((class color) (background dark)) (:foreground "forestgreen"))) + "引用部分の face" + :group 'pukiwiki-face) + +(defface pukiwiki-view-preformat-face + '((((class color) (background light)) (:foreground "slateblue")) + (((class color) (background dark)) (:foreground "darkslateblue"))) + "整形済みテキストの face (行頭の空白 7バイト以上)" + :group 'pukiwiki-face) + +(defface pukiwiki-view-preformat-face-1 + '((((class color) (background light)) (:foreground "slateblue")) + (((class color) (background dark)) (:foreground "darkslateblue"))) + "整形済みテキストの face (行頭の空白 1バイト)" + :group 'pukiwiki-face) + +(defface pukiwiki-view-preformat-face-2 + '((((class color) (background light)) (:foreground "mediumpurple")) + (((class color) (background dark)) (:foreground "blueviolet"))) + "整形済みテキストの face (行頭の空白 2バイト)" + :group 'pukiwiki-face) + +(defface pukiwiki-view-preformat-face-3 + '((((class color) (background light)) (:foreground "mediumseagreen")) + (((class color) (background dark)) (:foreground "seagreen"))) + "整形済みテキストの face (行頭の空白 3バイト)" + :group 'pukiwiki-face) + +(defface pukiwiki-view-preformat-face-4 + '((((class color) (background light)) (:foreground "deeppink")) + (((class color) (background dark)) (:foreground "hotpink"))) + "整形済みテキストの face (行頭の空白 4バイト)" + :group 'pukiwiki-face) + +(defface pukiwiki-view-preformat-face-5 + '((((class color) (background light)) (:foreground "lightcoral")) + (((class color) (background dark)) (:foreground "coral"))) + "整形済みテキストの face (行頭の空白 5バイト)" + :group 'pukiwiki-face) + +(defface pukiwiki-view-preformat-face-6 + '((((class color) (background light)) (:foreground "royalblue")) + (((class color) (background dark)) (:foreground "dodgerblue"))) + "整形済みテキストの face (行頭の空白 6バイト)" + :group 'pukiwiki-face) + +(defface pukiwiki-view-strikethru-face + '((((class color) (background light)) (:strikethru t)) + (((class color) (background dark)) (:strikethru t))) + "打ち消し線の face" + :group 'pukiwiki-face) + +(defface pukiwiki-view-list-1-face + '((((class color) (background light)) (:foreground "darkmagenta")) + (((class color) (background dark)) (:foreground "darkred"))) + "リスト項目の face" + :group 'pukiwiki-face) + +(defface pukiwiki-view-button-face + '((((class color) (background light)) (:foreground "darkgoldenrod")) + (((class color) (background dark)) (:foreground "goldenrod"))) + "anchor button の face" + :group 'pukiwiki-face) + +(defface pukiwiki-view-current-button-face + '((((class color) (background light)) (:background "Paleturquoise")) + (((class color) (background dark)) (:background "lightblue"))) + "ポイントが乗ったときの anchor button の face" + :group 'pukiwiki-face) + +(defface pukiwiki-view-url-face + '((((class color) (background light)) (:foreground "Blue")) + (((class color) (background dark)) (:foreground "mediumblue"))) + "anchor url の face" + :group 'pukiwiki-face) + +(defface pukiwiki-view-anchor-face + '((((class color) (background light)) (:underline t)) + (((class color) (background dark)) (:underline t))) + "wiki anchor の face" + :group 'pukiwiki-face) + +(defface pukiwiki-view-current-url-face + '((((class color) (background light)) (:background "Paleturquoise")) + (((class color) (background dark)) (:background "lightblue"))) + "ポイントが乗ったときの anchor url の face" + :group 'pukiwiki-face) + +(defface pukiwiki-index-current-line-face + '((((class color) (background light)) (:background "Yellow")) + (((class color) (background dark)) (:foreground "Gold"))) + "インデックス上のポイントが乗った行の face" + :group 'pukiwiki-face) + +;; index mode. +(defface pukiwiki-index-normal-face + '((((class color) (background light)) (:foreground "green4")) + (((class color) (background dark)) (:foreground "yellow"))) + "インデックスの通常行の face" + :group 'pukiwiki-face) + +(defface pukiwiki-index-cache-face + '((((class color) (background light)) (:foreground "BlueViolet")) + (((class color) (background dark)) (:foreground "green3"))) + "インデックスのキャッシュ済み行の face" + :group 'pukiwiki-face) + +(setq pukiwiki-index-font-lock-keywords + (list + '("^\\s-*\\([0-9]+\\s-+V\\s-+.+[0-9/]+$\\)" 1 pukiwiki-index-cache-face) + '("^\\s-*\\([0-9]+\\s-+.+\\s-+[0-9/]+$\\)" 1 pukiwiki-index-normal-face) + )) + (defvar pukiwiki-diff-font-lock-keywords (list '("\\(^+[^\n\r]*$\\)" 1 pukiwiki-added-face) @@ -237,39 +505,6 @@ (defvar pukiwiki-search-word nil) -(defcustom pukiwiki-no-proxy-domains-list '("localhost") - "*Domain list that don't via proxy server." - :group 'pukiwiki - :type '(repeat (string :format "Domain name: %v -" :size 0))) - -(defcustom pukiwiki-process-sentinel-interval 1 - "*Sentinel time for end of process." - :group 'pukiwiki - :type '(integer :size 0)) - -(defcustom pukiwiki-jump-display-window-top nil - "*Non-nil means displaying the pointer which moved at the top of a window." - :group 'pukiwiki - :type 'boolean) - -(defcustom pukiwiki-jump-display-window-top-without-content nil - "*Non-nil means excepting, if it is content -when displaying the pointer which moved at the top of a window." - :group 'pukiwiki - :type 'boolean) - -(defcustom pukiwiki-jump-display-window-upper-margin 0 - "*The margin of the window upper part when displaying the pointer -which moved at the top of a window." - :group 'pukiwiki - :type '(integer :size 0)) - -(defcustom pukiwiki-diff-using-ediff nil - "*Non-nil means using `Ediff' package for diff process." - :group 'pukiwiki - :type 'boolean) - ;;; 汎用関数 (defun pukiwiki-mode-version () @@ -460,7 +695,8 @@ (save-excursion (beginning-of-line) (setq pos (point)) - (while (and (setq result (pukiwiki-search-anchor pos)) + (while (and (setq result (pukiwiki-search-anchor + pos pukiwiki-anchor-regexp-alist)) (<= (cdr result) point)) (setq pos (cdr result))) (when (and result (<= (car result) point)) @@ -473,15 +709,16 @@ PREV が non-nil ならば、前のアンカーへ移動する。" (interactive "P") - (goto-char (or (car (pukiwiki-search-anchor (point) prev)) + (goto-char (or (car (pukiwiki-search-anchor + (point) pukiwiki-anchor-regexp-alist prev)) (point)))) -(defun pukiwiki-search-anchor (point &optional prev) +(defun pukiwiki-search-anchor (point list &optional prev) "POINT から最も近いアンカーを探す。 見つかったら (beginning . end) を、見つからなかったら nil を 返す" (let ((case-fold-search nil) - (alist pukiwiki-anchor-regexp-alist) + (alist list) result) (save-excursion (while alist @@ -804,30 +1041,91 @@ nil nil ((?_ . "w")) nil (font-lock-comment-start-regexp . "//"))) (pukiwiki-mode-set-font-lock 'pukiwiki-view-mode) + ;; hooks + (progn + (make-local-hook 'post-command-hook) + (add-hook 'post-command-hook 'pukiwiki-view-post-command-function nil t) + (make-local-hook 'pukiwiki-view-post-command-hook) + (add-hook 'pukiwiki-view-post-command-hook + (function + (lambda () + (pukiwiki-view-echo-url-at-point) + (pukiwiki-view-highlight-current-anchor))) + nil t)) (run-hooks 'pukiwiki-view-mode-hook)) +(add-hook 'pukiwiki-view-mode-hook + (function + (lambda () + (turn-off-font-lock) (turn-on-font-lock) + (setq fill-column (- (window-width) 4)) ; window width に合わせる。 + ))) + +(defun pukiwiki-view-post-command-function () + (run-hooks 'pukiwiki-view-post-command-hook)) + +(defun pukiwiki-view-echo-url-at-point () + (progn + (when (setq prop (get-text-property (point) 'url)) + (princ prop)))) + +(defun pukiwiki-view-highlight-current-anchor () + (progn + (pukiwiki-view-highlight-off-current-anchor) + (pukiwiki-view-highlight-on-current-anchor))) + +(defun pukiwiki-view-highlight-on-current-anchor () + (let ((pos (point)) + (type (get-text-property (point) 'anchortype)) + star end orig) + (when (and (get-text-property (point) 'anchor) + (or (eq 'url type) (eq 'pagename type))) + (save-excursion + ;; highlighit する region を特定する。 + (setq end (next-single-property-change (point) type)) + (setq start (previous-single-property-change end type)) + (unless start (setq start (point-min))) + + ;; overlay set. + (setq ovr-temp (make-overlay start end)) + (overlay-put ovr-temp 'face 'pukiwiki-view-current-url-face) + (overlay-put ovr-temp 'pukiwiki-temp-overlay t) + (overlay-put ovr-temp 'priority 1))))) + +(defun pukiwiki-view-highlight-off-current-anchor () + (let ((overlays (overlays-in (point-min) (point-max)))) + (while + (setq ovr (prog1 (car overlays) (setq overlays (cdr overlays)))) + (when (overlay-get ovr 'pukiwiki-temp-overlay) + (delete-overlay ovr))))) + (defun pukiwiki-view-setup-keys () "Set up keymap for pukiwiki-edit-mode. If you want to set up your own key bindings, use `pukiwiki-edit-mode-hook'." (local-set-key "q" 'pukiwiki-diff-exit) (local-set-key "b" 'scroll-down) (local-set-key " " 'scroll-up) + (local-set-key "B" 'pukiwiki-view-backward-page) + (local-set-key "g" 'pukiwiki-view-goto-page) (local-set-key "c" 'pukiwiki-view-return-contents) (local-set-key "e" 'pukiwiki-view-edit-current-page) (local-set-key "\C-m" 'pukiwiki-view-return-function) (local-set-key "\C-i" 'pukiwiki-jump-anchor) (local-set-key "\M-\C-i" 'pukiwiki-jump-anchor-prev) (local-set-key "\C-xv=" 'pukiwiki-index-show-diff) + (local-set-key "n" 'pukiwiki-jump-anchor-window-top) + (local-set-key "p" 'pukiwiki-jump-anchor-window-top-prev) + (local-set-key "s" 'pukiwiki-view-local-style-set) ) (defun pukiwiki-view-edit-current-page () "現在行のページを編集する。" (interactive) - (if (and - pukiwiki-pagename - pukiwiki-site-info) - (pukiwiki-edit-page pukiwiki-pagename pukiwiki-site-info))) - + (when (and + pukiwiki-pagename + pukiwiki-site-info) + (let ((buf (pukiwiki-edit-page pukiwiki-pagename pukiwiki-site-info))) + (when buf (switch-to-buffer buf))))) ;;; 一覧モード(pukiwiki-index-*) (make-variable-buffer-local 'pukiwiki-site-info) @@ -840,11 +1138,65 @@ \\{pukiwiki-index-mode-map}" (make-local-variable 'pukiwiki-site-info) (make-local-variable 'pukiwiki-index-page-info-list) + ;; InterWikiName + (make-local-variable 'pukiwiki-index-interwiki-info-list) + (make-local-variable 'pukiwiki-index-attach-list) (make-local-variable 'pukiwiki-index-sort-key) (pukiwiki-index-setup-keys) + ;; hooks + (progn + (make-local-hook 'post-command-hook) + (add-hook 'post-command-hook 'pukiwiki-index-post-command-function nil t) + (make-local-hook 'pukiwiki-index-post-command-hook) + (add-hook 'pukiwiki-index-post-command-hook + (function + (lambda () + (pukiwiki-index-highlight-current-line))) + nil t)) (run-hooks 'pukiwiki-index-mode-hook)) +(add-hook 'pukiwiki-index-mode-hook + (function + (lambda () + (make-local-variable 'font-lock-defaults) + (setq font-lock-defaults + '(pukiwiki-index-font-lock-keywords + nil nil ((?_ . "w")) nil)) + (pukiwiki-mode-set-font-lock 'pukiwiki-index-mode) + (turn-off-font-lock) (turn-on-font-lock)))) + +(defun pukiwiki-index-post-command-function () + (run-hooks 'pukiwiki-index-post-command-hook)) + +(defun pukiwiki-index-highlight-current-line () + (progn + (pukiwiki-index-highlight-on-current-line))) + +(defun pukiwiki-index-highlight-on-current-line () + (let ((pos (point)) + star end) + (unless (get-text-property (point) 'pukiwiki-current-line) + (save-excursion + ;; これまでの overlays を一掃する。 + (pukiwiki-index-highlight-off-current-line) + ;; highlighi する region を特定する。 + (setq start (line-beginning-position)) + (setq end (1+ (line-end-position))) + + ;; overlay set. + (setq ovr-temp (make-overlay start end)) + (overlay-put ovr-temp 'face 'pukiwiki-index-current-line-face) + (overlay-put ovr-temp 'pukiwiki-current-line t) + (overlay-put ovr-temp 'priority 1))))) + +(defun pukiwiki-index-highlight-off-current-line () + (let ((overlays (overlays-in (point-min) (point-max)))) + (while + (setq ovr (prog1 (car overlays) (setq overlays (cdr overlays)))) + (when (overlay-get ovr 'pukiwiki-current-line) + (delete-overlay ovr))))) + (defun pukiwiki-index-setup-keys () "Set up keymap for pukiwiki-index-mode. If you want to set up your own key bindings, use `pukiwiki-index-mode-hook'." @@ -859,6 +1211,7 @@ (define-key pukiwiki-index-mode-map "R" 'pukiwiki-index-refetch-index) (define-key pukiwiki-index-mode-map "q" 'pukiwiki-index-suspend) (define-key pukiwiki-index-mode-map "Q" 'pukiwiki-index-quit) + (define-key pukiwiki-index-mode-map "B" 'pukiwiki-index-view-backward-page) (define-key pukiwiki-index-mode-map "n" 'pukiwiki-index-next-page) (define-key pukiwiki-index-mode-map "p" 'pukiwiki-index-prev-page) ;;(define-key pukiwiki-index-mode-map "j" 'pukiwiki-index-jump-chapter) @@ -885,7 +1238,7 @@ (when (null site-info) (setq site-info (pukiwiki-read-site-name))) (setq buf (pukiwiki-display-index site-info refetch pagename)) - (switch-to-buffer buf) + (set-buffer buf) ; 画面がチラ付くので変更しました。 (pukiwiki-index-sort nil ?d) (unless pagename (delete-other-windows)))) @@ -920,6 +1273,11 @@ (message "Loading index list...") (setq pukiwiki-index-page-info-list (pukiwiki-fetch-index site-info)) + ;; InterWikiName + (message "Loading InterWikiName list...") + (setq pukiwiki-index-interwiki-info-list + (pukiwiki-fetch-interwikiname site-info)) + (message "Loading attach list... (C-g for Cancel)") (condition-case err (setq pukiwiki-index-attach-list @@ -943,7 +1301,7 @@ (re-search-forward (format "^%4d" (nth 0 elm))) (beginning-of-line) (recenter)))) - (switch-to-buffer old-buf) + (set-buffer old-buf) ; 画面がチラ付くので変更しました。 buf)) (defun pukiwiki-index-get-buffer-create (site-info) @@ -991,7 +1349,8 @@ (setq pagename (nth 1 page-info)) (delete-other-windows) (split-window nil 10) - (recenter t) + ;; 画面がチラ付くので外してみました。 + ;; (recenter t) (other-window 1) (pukiwiki-display-page pagename pukiwiki-site-info refetch) (pukiwiki-view-mode) @@ -1015,10 +1374,12 @@ (pukiwiki-view-reformating) (setq buffer-read-only t) + (switch-to-buffer (current-buffer)) ; 画面がチラ付くので変更しました。 (other-window 1)) (pukiwiki-index pukiwiki-site-info nil pagename) (switch-to-buffer cbuf) - (goto-char point))) + (goto-char point) + (recenter))) (defun pukiwiki-index-display-page-next (&optional refetch) "現在行のページを表示する。すでに表示されている時はスクロールする。 @@ -1252,7 +1613,7 @@ (message "Ediff session...") ;; 最新バックアップのソースを取得し、バッファを生成。 - (setq backup-buffername (concat "*pukiwiki backup tmp*")) + (setq backup-buffername (concat " *pukiwiki backup tmp*")) (let* ((backup t) (url (progn (string-match "nowdiff" url) (replace-match "source" nil nil url)))) @@ -1260,7 +1621,7 @@ url pagename site-info backup-buffername backup)) ;; 現在のソースを取得し、バッファを生成。 - (setq current-buffername (concat "*pukiwiki current tmp*")) + (setq current-buffername (concat " *pukiwiki current tmp*")) (let* ((url (progn (string-match "cmd=backup\\(.*\\)&age=[0-9]*&action=nowdiff" url) @@ -1275,9 +1636,8 @@ buffername &optional backup day) (let ((raw backup)) - (setq contents (pukiwiki-fetch-source - pagename url - (pukiwiki-site-coding-system site-info) raw)) + (setq contents (pukiwiki-fetch-source pagename url + (pukiwiki-site-coding-system site-info) raw)) (setq buf (get-buffer-create buffername)) (switch-to-buffer buf) (setq buffer-read-only nil) @@ -1289,12 +1649,15 @@ (pukiwiki-view-mode) (when pukiwiki-auto-insert ; 整形ありのとき。 + (pukiwiki-set-auto-face) + (pukiwiki-text-reformating) (pukiwiki-insert-paragraph) (pukiwiki-insert-cite) (pukiwiki-insert-list) (pukiwiki-insert-ls2) - (pukiwiki-set-auto-face) + (pukiwiki-insert-simple-elements) + (pukiwiki-delete-blank-line) (pukiwiki-view-renumber)) @@ -2115,26 +2478,9 @@ (goto-char (point-min))) (and buf (kill-buffer buf)) (message "Loading...") - (condition-case err - (setq result (pukiwiki-fetch-source - pagename (pukiwiki-site-url site-info) - (pukiwiki-site-coding-system site-info))) - (error - (setq result (pukiwiki-fetch-source - pagename - (format "%s?cmd=%s&page=%s" - (pukiwiki-site-url site-info) - "diff" - (http-url-hexify-string - pagename - (pukiwiki-site-coding-system site-info))) - (pukiwiki-site-coding-system site-info) - 'diff)) - (setq result (delete (list 'password) result)) - (setq result - (cons - (cons 'password t) - result)))) + (setq result + (pukiwiki-fetch-source-in-order pagename site-info 'browse-extra)) + (setq body (cdr (assoc 'body result))) (setq pagetitle (cdr (assoc 'pagetitle result))) (setq password (cdr (assq 'password result))) @@ -2152,7 +2498,7 @@ (setq result nil)) not-cancelled))) (setq buf (generate-new-buffer "*pukiwiki tmp*")) - (switch-to-buffer buf) + (set-buffer buf) ; 画面がチラ付くので変更しました。 (pukiwiki-edit-rename-buffer (pukiwiki-site-name site-info) pagename pagetitle password) (save-excursion @@ -2266,6 +2612,63 @@ (setcdr history (mapcar (lambda (elm) (cons (nth 1 elm) nil)) indexes)) (reverse indexes)))) +;; InterWikiName +(defun pukiwiki-fetch-interwikiname (site-info) + "InterWikiName の一覧を取得する。" + + (save-excursion + ;; InterWikiName ページのソースを取得し、バッファを生成。 + (setq interwiki-buffername (concat " *pukiwiki interwiki tmp*")) + (let* ((url (concat (pukiwiki-site-url site-info) + "?cmd=edit&page=InterWikiName")) + (buf (pukiwiki-interwiki-create-buffer + url "InterWikiName" site-info interwiki-buffername))) + + ;; list を生成。 + (set-buffer buf) + (goto-char (point-min)) + (setq interwikiname-list nil) + (while (re-search-forward + "\\[\\(https*://[^ ]+\\) \\([^]]+\\)\\][ \t]*\\([^ \n\r]*\\).*$" + nil t) + (save-match-data + (setq match-url (match-string 1)) + (setq start 0 pos 0) + (while (setq pos (string-match "&" match-url start)) + (setq match-url (replace-match "&" nil nil match-url)) + (setq start pos))) + (setq interwikiname-list + (cons + (list (match-string 2) + match-url + nil + (cond + ((string= "euc" (match-string 3)) 'euc-jp-dos) + ((string= "sjis" (match-string 3)) 'shift_jis-dos) + ((string= "utf8" (match-string 3)) 'utf-8-dos) + ((string= "" (match-string 3)) 'utf-8-dos) + ((string= "raw" (match-string 3)) nil) + (t + (intern (match-string 3))))) + interwikiname-list))) + + (kill-buffer buf) + interwikiname-list))) + +(defun pukiwiki-interwiki-create-buffer (url pagename site-info + buffername + &optional opt) + (let* ((raw opt) + (contents (pukiwiki-fetch-source pagename url + (pukiwiki-site-coding-system site-info) raw)) + (buf (get-buffer-create buffername))) + + (set-buffer buf) + (setq buffer-read-only nil) + (erase-buffer) + (insert (cdr (assoc 'body contents))) + buf)) + (defun pukiwiki-fetch-attach-index (site-info) "添付ファイルの一覧を表示する。" (let (indexes @@ -2309,6 +2712,56 @@ indexes))))) indexes)) +(defun pukiwiki-fetch-source-in-order (page info &optional browser) + "与えられた page のデータを読み込む。 +先ず編集モードで読み込み、正当なデータが得られなかったら、差分モードで読む。 +差分も取得できなければ error 終了する。 +BROWSER が非 nil なら、差分も取得できなかったときに `browse-url' により、 +外部ブラウザでの読み込みを行なう。" + + (let ((pagename page) + (site-info info) + (browse-extra browser) + result) + + (condition-case err + (setq result (pukiwiki-fetch-source + pagename (pukiwiki-site-url site-info) + (pukiwiki-site-coding-system site-info))) + (error + (condition-case err + (setq result (pukiwiki-fetch-source + pagename + (format "%s?cmd=%s&page=%s" + (pukiwiki-site-url site-info) + "diff" + (http-url-hexify-string + pagename + (pukiwiki-site-coding-system site-info))) + (pukiwiki-site-coding-system site-info) + 'diff)) + (error + ;; 'diff で request しても Pukiwiki のテキストが見付からなかった + ;; 場合は、外部ブラウザにも依頼する。 + (when (and browse-extra pukiwiki-interwiki-browse-not-match-pukiwiki) + (let ((url (pukiwiki-site-url site-info t))) + (if (string-match "$1" url) + (progn + (setq url (replace-match + (http-url-hexify-string + page + (pukiwiki-site-coding-system site-info)) + nil nil url)) + (browse-url url)) + (browse-url (concat url page))))) + (error "PukiWiki のテキストが見つかりません"))) + + (setq result (delete (list 'password) result)) + (setq result + (cons + (cons 'password t) + result)))))) + (defun pukiwiki-fetch-source (pagename site-url coding-system &optional raw) "Pukiwiki の ソースを取得する。 @@ -2445,8 +2898,13 @@ (defun pukiwiki-site-name (&optional site-info) (nth 0 (or site-info pukiwiki-site-info))) -(defun pukiwiki-site-url (&optional site-info) - (nth 1 (or site-info pukiwiki-site-info))) +;; 2004.09.27 InterWikiName で、末尾が `?' な url も与えられてしまうので。 +;; (defun pukiwiki-site-url (&optional site-info) +;; (nth 1 (or site-info pukiwiki-site-info))) +(defun pukiwiki-site-url (&optional site-info no-strip) + (let ((url (nth 1 (or site-info pukiwiki-site-info)))) + (if (and (not no-strip) (string-match "\\?$" url)) + (replace-match "" nil nil url) url))) (defun pukiwiki-site-style (&optional site-info) (or (nth 2 (or site-info pukiwiki-site-info)) @@ -2491,7 +2949,7 @@ If STR is a string, replace entity references within the string. Otherwise replace all entity references within current buffer." (pukiwiki-do-replace-entity-ref - "&" "&" + " " " " (pukiwiki-do-replace-entity-ref "<" "<" (pukiwiki-do-replace-entity-ref @@ -2499,7 +2957,16 @@ (pukiwiki-do-replace-entity-ref """ "\"" (pukiwiki-do-replace-entity-ref - "'" "'" str)))))) + "'" "'" + (pukiwiki-do-replace-entity-ref + "<" "<" + (pukiwiki-do-replace-entity-ref + ">" ">" + (pukiwiki-do-replace-entity-ref + "&" "&" + (pukiwiki-do-replace-entity-ref + "&" "&" str + )))))))))) (defun pukiwiki-do-replace-entity-ref (from to &optional str) (save-match-data @@ -2566,26 +3033,44 @@ ;;; for pukiwiki ;;;; ページ表示の整形関連 -(defun pukiwiki-insert-comment-str (str) +(defun pukiwiki-insert-comment-str (str &optional region-start region-end) + (let ((beg (or region-start (point))) + (end (or region-end (1+ (point)))) + (end-marker (make-marker))) + + (if str + (progn + (set-marker end-marker end) + (insert str) + (pukiwiki-insert-comment-str-subr beg end-marker) + (insert "\n")) + (pukiwiki-insert-comment-str-subr beg end)))) + +(defun pukiwiki-insert-comment-str-subr (beg end) + (narrow-to-region beg end) + (let ((contents nil) (lth nil) (end nil)) - (with-temp-buffer - (text-mode) - (insert str) + ;; 改行されているコメントを、コメントごとに一行に詰め込む。 + (pukiwiki-insert-comment-str-fill-line) (goto-char (point-min)) (keep-lines "^-") (goto-char (point-min)) - (pukiwiki-replace-string "&new{" "" nil (point-min) (point-max)) + + ;; 実体参照や特殊文字を解決。 + (pukiwiki-replace-entity-refs) (pukiwiki-replace-string "&new{" "" nil (point-min) (point-max)) - (pukiwiki-replace-string "SIZE(10){" "" nil (point-min) (point-max)) + (pukiwiki-replace-regexp "SIZE([0-9]+){" "" nil (point-min) (point-max)) (pukiwiki-replace-regexp "}[;]*" "" nil (point-min) (point-max)) - (pukiwiki-replace-regexp - "^\\([-]+\\)\\([^\n\r]+\\)[ ]*--[ ]*\\[\\[\\([^]\n\r]+\\)\\]\\] \\([^\n\r]+\\)[ ]*$" - "\\1 \\4 [\\3]\n \\2" - nil (point-min) (point-max)) - (pukiwiki-replace-regexp - "^\\([-]+\\)\\([^\n\r]+\\)[ ]*--[ ]*\\([^[\n\r]+\\)[ ]*$" - "\\1 \\3 [名無し]\n \\2" - nil (point-min) (point-max)) + + ;; コメントの形式を見易い様に変換。 + ;; overlay が削られてしまうので変更してみました。 + (pukiwiki-replace-comment + "^\\([-]+\\)\\([^\n\r]+\\)\\([ ]*--[ ]*\\)\\(\\[\\[[^]\n\r]+\\]\\]\\) \\([^\n\r]+\\)[ ]*$" + (point-min) (point-max)) + (pukiwiki-replace-comment + "^\\([-]+\\)\\([^\n\r]+\\)\\([ ]*--[ ]*\\)\\([^[\n\r]+\\)[ ]*$" + (point-min) (point-max)) + (pukiwiki-replace-regexp "[ ]+$" "" nil (point-min) (point-max)) @@ -2616,49 +3101,911 @@ (format "%s" (make-string (* 2 lth) ? ))) (forward-line 1) (beginning-of-line))))) - ;; (replace-regexp "^[-]+" - ;; "_" - ;; nil (point-min) (point-max)) + + ;; anchor を有効に。 + (let ((beg (point-min-marker)) + (end (point-max-marker))) + (unwind-protect + (pukiwiki-insert-comment-with-anchor (point-min) (point-max)) + (save-excursion + (set-buffer (marker-buffer beg)) + (narrow-to-region beg end)))) + (fill-region (point-min) (point-max)) (pukiwiki-replace-regexp "\n[ ]*\n" "\n" - nil (point-min) (point-max)) - (setq contents (buffer-substring-no-properties - (point-min) (point-max)))) - (insert contents))) + nil (point-min) (point-max))) + (widen)) + +(defun pukiwiki-replace-comment (regexp start end) + "コメントの書式を変換する。" + + (let ((top start) (bottom end) (next (make-marker)) (prev start) header) + (goto-char top) + (catch 'range-over + (while (setq result (re-search-forward regexp bottom t)) + (set-marker next result) + (setq header (concat (match-string 1) " " + (or (match-string 5) "") " " + (match-string 4) "\n")) + (when (match-string 5) + (delete-region (match-beginning 5) (match-end 5))) + (delete-region (match-beginning 4) (match-end 4)) + (delete-region (match-beginning 3) (match-end 3)) + (delete-region (match-beginning 1) (match-end 1)) + + (save-excursion + (goto-char (match-beginning 1)) + (insert " ") + (forward-char -1) + ;; delete overlay from invalid point. + (let ((overlays (overlays-in (point) (1+ (point))))) + (while + (setq ovr (prog1 (car overlays) (setq overlays (cdr overlays)))) + (when (overlay-get ovr 'overlay) + (move-overlay ovr + (1+ (overlay-start ovr)) (overlay-end ovr))))) + ;; delete properties from invalid point. + (set-text-properties (point) (1+ (point)) nil) + (insert (concat header " "))) + + (setq bottom (+ bottom (- next result))) + (if (>= (point) bottom) ; insert で next が bottom よりも + ; 先に進んだ時も 'range-over. + (throw 'range-over t)) + (setq prev next)) + (cond ((eq result nil) ; もう match しなかった。 + (throw 'range-over t)) + ((>= next bottom) ; next が bottom を越えた。 + (throw 'range-over t)))))) + +(defun pukiwiki-insert-comment-str-fill-line () + "改行されているコメントを一行に詰め込む。" + + (save-excursion + (let (beg end next) + (goto-char (point-min)) + (catch 'not-match + (while (re-search-forward "^-" nil t) + (setq beg (line-beginning-position) + next (point)) + (if (re-search-forward "^-" nil t) + (progn + (forward-line -1) + (setq end (line-end-position))) + (throw 'not-match t)) + (pukiwiki-replace-regexp "\n" "" nil beg end) + (goto-char next)))))) + +(defun pukiwiki-insert-comment-with-anchor (start end) + (narrow-to-region start end) + ;; with delete url description. + (pukiwiki-insert-anchor + (cdr (assoc 'delete-url-description pukiwiki-style-anchor-regexp-alist))) + ;; to leave url description. + (pukiwiki-insert-anchor + (cdr (assoc 'leave-url-description pukiwiki-style-anchor-regexp-alist))) + (widen) + (point)) (defun pukiwiki-insert-comment () "pcomment によるコメントを挿入する" - (let ((comment nil)) + (let ((comment nil) reply-option) (save-excursion (save-current-buffer (goto-char (point-min)) - (when (re-search-forward "^#pcomment\\((reply)\\|\\)" nil t) - (message "Inserting pcomment...") - (setq comment - (pukiwiki-fetch-source - (concat "コメント/" pukiwiki-pagename) - (pukiwiki-site-url pukiwiki-site-info) - (pukiwiki-site-coding-system pukiwiki-site-info))) - (forward-line 1) - (if (cdr (assoc 'body comment)) - (pukiwiki-insert-comment-str (cdr (assoc 'body comment)))) - (pukiwiki-replace-entity-refs)) + (setq pname nil) + (while (re-search-forward + "^#pcomment\\((\\([^)]*\\)reply\\([^)]*\\))\\)*$" nil t) + (let ((options (concat (match-string 2) (match-string 3))) + option pname) + (catch 'match + (while (string-match "\\([^,]*\\) *, *\\(.*\\)" options) + (setq option (match-string 1 options)) + (setq options (match-string 2 options)) + (when (and (not (string= "" option)) + (not (string= "noname" option)) + (not (string= "nodate" option)) + (not (string= "above" option)) + (not (string= "below" option)) + (not (string-match "^[0-9]+$" option))) + (setq pname option) + (throw 'match t)))) + (unless pname + (setq pname + (if (string-match "\\[\\[\\(.+\\)\\]\\]" pukiwiki-pagename) + ;; 1.3 系の BracketName + (concat "[[" "コメント/" + (match-string 1 pukiwiki-pagename) "]]") + (concat "コメント/" pukiwiki-pagename)))) + + (message "Inserting comment...") + (setq comment + (pukiwiki-fetch-source-in-order + pname + pukiwiki-site-info nil)) + (forward-line 1) + (if (cdr (assoc 'body comment)) + (pukiwiki-insert-comment-str (cdr (assoc 'body comment)))) + ;; 2004.09.20 reply 対象のコメントを選択可能に。 + (pukiwiki-view-comment-form-pcomment-reformat) + + (pukiwiki-replace-entity-refs)))))) + (message "Inserting comment...done!")) + +;; comment form に対応。 +(defcustom pukiwiki-view-form-text-input-style nil + "*comment form のテキスト入力項目の表示、入力形式。" + :group 'pukiwiki + :type '(radio (const :tag "Not specified" nil) + (const :format "Ask name and comment: %v\n" ask) + (const :format "Display input text form: %v\n" form) + (const :format "Display input text form by large area: %v\n" large) + )) + +(defcustom pukiwiki-view-form-textarea-buffer-height 10 + "*Hieght of the MESSAGE input buffer." + :group 'pukiwiki + :type '(integer :size 0)) + +(defvar pukiwiki-view-form-elem-text-list + '("name" "msg") + "comment form のテキスト入力項目の要素リスト") + +(defvar pukiwiki-view-form-elem-list + '("encode_hint" "refer" "plugin" "nodate" "digest" "comment") + "comment form の共通な要素リスト") + +(defvar pukiwiki-view-form-elem-comment-list + '("comment_no" "above") + "comment form のみに必要な要素リスト") + +(defvar pukiwiki-view-form-elem-pcomment-list + '("reply" "page" "dir" "count") + "pcomment form のみに必要な要素リスト") + +(defvar pukiwiki-view-form-elem-article-list + '("article_no") + "article form のみに必要な要素リスト") + +(defun pukiwiki-view-form-textarea-setup-keys () + "Set up keymap for pukiwiki-view-form-textarea-mode. +If you want to set up your own key bindings, +use `pukiwiki-view-form-textarea-mode-hook'." + (define-key pukiwiki-view-form-textarea-mode-map + "\C-c\C-c" 'pukiwiki-view-form-textarea-set) + (define-key pukiwiki-view-form-textarea-mode-map + "\C-c\C-k" 'pukiwiki-view-form-textarea-exit) + (define-key pukiwiki-view-form-textarea-mode-map + "\C-c\C-q" 'pukiwiki-view-form-textarea-exit) + (define-key pukiwiki-view-form-textarea-mode-map + "\C-c\C-y" 'pukiwiki-view-form-textarea-buffer-history-yank)) + +(defun pukiwiki-view-form-textarea-set (&optional no-hist) + "入力されたデータを保存してバッファを破棄し、元の状態に復帰します。 +前置引数が指定されると、バッファ入力履歴への保存を行ないません。" + + (interactive "P") + + ;; バッファの破棄と元の状態への復帰。 + (let* ((ret (pukiwiki-view-form-textarea-exit no-hist)) + (input (car ret)) + (type (cdr ret))) + ;; 入力データの反映。 + (pukiwiki-view-comment-form-input 'already input type))) + +(defun pukiwiki-view-form-textarea-exit (&optional no-hist) + "入力されたデータとバッファを破棄し、元の状態に復帰します。 +前置引数が指定されると、バッファ入力履歴への保存を行ないません。" + + (interactive "P") + + (let ((input (buffer-string)) + (kbuf (current-buffer)) + (buf pukiwiki-view-form-textarea-orig-buf) + (pos pukiwiki-view-form-textarea-orig-pos) + (type pukiwiki-view-form-textarea-orig-type) + (wincfg pukiwiki-view-form-textarea-orig-wincfg)) + ;; 履歴に保持。 + (unless no-hist + (pukiwiki-view-form-textarea-buffer-history-push input)) + ;; バッファを破棄し、元の状態への復帰。 + (pukiwiki-view-form-textarea-kill-and-restore kbuf buf pos wincfg) + (cons input type))) + +(defun pukiwiki-view-form-textarea-kill-and-restore (kbuf buf pos config) + "バッファを破棄し、元の状態への復帰します。" + + ;; textarea buffer を抜ける。 + (kill-buffer kbuf) + ;; buffer, point, window の復元。 + (set-buffer buf) + (goto-char pos) + (set-window-configuration config)) + +(defun pukiwiki-view-form-textarea-buffer-history-push (str) + "Textarea バッファへの入力履歴を保存します。 +STR に指定された文字列を、履歴として保存します。" + + (when (and (> (length str) 0) + (not + (string= str (car pukiwiki-view-form-textarea-buffer-history)))) + (let ((history (cons str pukiwiki-view-form-textarea-buffer-history))) + (when (and str history) + (setq pukiwiki-view-form-textarea-buffer-history history) + ;; 履歴保持の最大数を超えたら、最古のものから削除する。 + (when (> (length pukiwiki-view-form-textarea-buffer-history) + pukiwiki-view-form-textarea-buffer-history-keep-count) + (setq pukiwiki-view-form-textarea-buffer-history + (nreverse + (cdr + (nreverse pukiwiki-view-form-textarea-buffer-history))))))))) + +(defun pukiwiki-view-form-textarea-buffer-history-get (&optional num) + "Textarea バッファへの入力履歴を取り出します。 +NUM に数値が指定されると、最新から NUM 番目の履歴を取り出します。 +NUM が nil か 0 だと、最新の履歴を取り出します。" + + (let ((newest (car pukiwiki-view-form-textarea-buffer-history)) + (specified + (and num (nth num pukiwiki-view-form-textarea-buffer-history)))) + (if specified specified newest))) + +(defvar pukiwiki-view-form-textarea-buffer-history nil + "Textarea への入力内容の履歴リスト") +(defvar pukiwiki-view-form-textarea-buffer-history-count 0 + "Textarea 入力バッファでの連続した yank command の実行回数") +(defvar pukiwiki-view-form-textarea-buffer-history-prepos 0 + "Textarea 入力バッファで、連続 yank する際に、以前の yank 内容を削除する +開始位置。") + +(defun pukiwiki-view-form-textarea-buffer-history-yank (&optional num) + "Textarea バッファへの入力履歴を yank します。 +このコマンドを連続して実行すると、逐次、履歴を遡って yank します。 +履歴の最古に到達すると、次は最新の履歴を yank します。" + + (interactive "P") + (let* ((same-command (eq this-command last-command)) + (num + (if same-command + (setq pukiwiki-view-form-textarea-buffer-history-count + (if (= (1+ pukiwiki-view-form-textarea-buffer-history-count) + (length pukiwiki-view-form-textarea-buffer-history)) + 0 + (1+ pukiwiki-view-form-textarea-buffer-history-count))) + (setq pukiwiki-view-form-textarea-buffer-history-prepos (point)) + (setq pukiwiki-view-form-textarea-buffer-history-count 0))) + (pos pukiwiki-view-form-textarea-buffer-history-prepos) + (result (pukiwiki-view-form-textarea-buffer-history-get num))) + (when same-command + (delete-region pos (point))) + (insert result))) + +(define-derived-mode pukiwiki-view-form-textarea-mode text-mode + "Pukiwiki Textarea" + "Major mode for input buffer of textarea. + +\\{pukiwiki-view-form-textarea-mode-map}" + + (pukiwiki-view-form-textarea-setup-keys) + + (make-local-variable 'pukiwiki-view-form-textarea-orig-buf) + (make-local-variable 'pukiwiki-view-form-textarea-orig-pos) + (make-local-variable 'pukiwiki-view-form-textarea-orig-type) + (make-local-variable 'pukiwiki-view-form-textarea-orig-wincfg) + + (setq mode-name "pukiwiki view form textarea" + major-mode 'pukiwiki-view-form-textarea-mode) + (run-hooks 'pukiwiki-view-form-textarea-mode-hook)) + +(defun pukiwiki-view-form-input (input-type property) + (let ((prop property) + (type input-type)) + (pukiwiki-view-comment-form-input type))) + +(defun pukiwiki-view-form-select-radio-button (select) + (let ((pos (point)) + (status select) + star end) + (when (and (get-text-property (point) 'anchor) + (numberp (get-text-property (point) 'radio))) + + ;; radio button の選択は、`*' を表示することで表現する。 + (save-excursion + ;; 対象 extent の保持。 + (goto-char (next-single-property-change (point) 'anchor)) + (setq end (point)) + (setq start (previous-single-property-change (point) 'anchor)) + + ;; all clear. + (pukiwiki-view-form-unselect-all-radio-button) + + ;; toggle select status. (on or off) + (if (eq 'yes status) + (add-text-properties start end (list 'select 'no)) + (add-text-properties start end (list 'select 'yes)))) + ;; mark update. + (pukiwiki-view-form-select-radio-button-refresh start end)) + (goto-char pos))) + +(defun pukiwiki-view-form-select-radio-button-refresh (start end) + (let ((status (get-text-property start 'select))) + (setq buffer-read-only nil) + (goto-char start) + (re-search-forward "[ *]" nil t) + (if (eq 'yes status) + (replace-match "*") + (replace-match " ")) + (setq buffer-read-only t))) + +(defun pukiwiki-view-form-unselect-all-radio-button () + (save-excursion + (let ((start (previous-single-property-change (point) 'pcomment-start)) + (end (next-single-property-change (point) 'pcomment-end)) + next) + (goto-char start) + (while (< (setq next + (next-single-property-change (point) 'anchorhead nil end)) + end) + (progn + (goto-char next) + (when (get-text-property (point) 'radio) + (setq next-end (next-single-property-change (point) 'anchor)) + (add-text-properties next next-end (list 'select 'no)) + (pukiwiki-view-form-select-radio-button-refresh next next-end))))))) + +(defun pukiwiki-view-comment-form-input (input-type &optional input original) + (let ((pos (point)) + (type input-type) + (orig-type original) + (data input)) + (save-excursion + ;; minibuffer か、Textarea 入力用バッファからの入力を受け付けて、 + (cond + ((eq type 'name) + (setq data (cdr (pukiwiki-view-comment-form-text-input-get-name)))) + ((eq type 'comment) + (if (eq pukiwiki-view-form-text-input-style 'large) + (pukiwiki-view-comment-form-text-input-get-str-from-buffer + (current-buffer) pos type) + (setq data + (cdr (pukiwiki-view-comment-form-text-input-get-comment))))) + ((eq type 'subject) + (setq data (cdr (pukiwiki-view-comment-form-text-input-get-subject)))) + ((eq type 'message) + (if (eq pukiwiki-view-form-text-input-style 'large) + (pukiwiki-view-comment-form-text-input-get-str-from-buffer + (current-buffer) pos type) + (setq data + (cdr (pukiwiki-view-comment-form-text-input-get-message))))) + (t nil)) + (unless (null data) + (when (= (length data) 0) (setq data nil))) + + (when (or (eq type 'name) + (and (eq type 'comment) + (not (eq pukiwiki-view-form-text-input-style 'large))) + (eq type 'subject) + (and (eq type 'message) + (not (eq pukiwiki-view-form-text-input-style 'large))) + (eq type 'already)) + + (when (eq type 'already) ; 'already の場合は元の type に戻す。 + (setq type original)) + + ;; 範囲を特定し、 + (setq start + (next-single-property-change (line-beginning-position) type)) + (setq end (next-single-property-change start type)) + + ;; property に設定すると共に、buffer を書き換える。 + (setq buffer-read-only nil) + (delete-region (line-beginning-position) end) + (pukiwiki-view-comment-form-insert-input type data) + (setq buffer-read-only t))) + (goto-char pos))) + +(defun pukiwiki-view-form-submit (property) + (let ((prop property)) + (when (pukiwiki-view-comment-form-request prop) + (pukiwiki-view-display-page pukiwiki-pagename 1 nil t)))) + +(defun pukiwiki-view-comment-form-request (property) + (interactive) + + ;; element の収集。 + (let* ((prop property) + (plugin (cdr (assoc "plugin" prop))) + (list (append pukiwiki-view-form-elem-list + (cond ((string= "comment" plugin) + pukiwiki-view-form-elem-comment-list) + ((string= "pcomment" plugin) + pukiwiki-view-form-elem-pcomment-list)))) + post-data) + + ;; 入力項目以外。この時点では reply は list のまま。 + (mapcar (lambda (key) (add-to-list 'post-data (assoc key prop))) list) + ;; 入力項目。 + (setq post-data + (pukiwiki-view-comment-form-text-input-get post-data plugin)) + + (if (string= "" (cdr (assoc "msg" post-data))) + (progn (message "Comment text missing!!") nil) + ;; request を post する。 + (message "Putting Text...") + (setq buf + (pukiwiki-http-request 'post nil pukiwiki-pagename + (pukiwiki-site-url) + (pukiwiki-site-coding-system) + post-data)) + t))) + +(defun pukiwiki-view-comment-form-text-input-get (post plugin) + (let (flag) + ;; post する form に入力されたデータを取得。 + (cond + ;; 入力済みの項目内容を properties から得る。 + ((or (eq pukiwiki-view-form-text-input-style 'form) + (eq pukiwiki-view-form-text-input-style 'large)) + (setq result-list + (pukiwiki-view-comment-form-text-input-get-data plugin)) + (add-to-list 'post (assoc "name" result-list)) + + (cond + ((string-match "p*comment" plugin) + (add-to-list 'post (assoc "msg" result-list)) + (if (assoc "reply" result-list) + (setq order (1- (cdr (assoc "reply" result-list)))) + (setq order (car (rassoc "0" (car (cdr (assoc "reply" post))))))) + (when (string= plugin "pcomment") + (when (assoc "reply" post) + (setcdr (assoc "reply" post) + (cdr (assoc order (car (cdr (assoc "reply" post))))))))) + + ((string= plugin "article") + (add-to-list 'post (assoc "subject" result-list)) + (add-to-list 'post (assoc "msg" result-list))))) + + ((eq pukiwiki-view-form-text-input-style 'ask) + ;; ミニバッファから。 + (add-to-list 'post + (pukiwiki-view-comment-form-text-input-get-name)) + (cond + ((string-match "p*comment" plugin) + (add-to-list 'post + (pukiwiki-view-comment-form-text-input-get-comment)) + (when (string= plugin "pcomment") + ;; 選択された順序番号を持つ `reply' に絞るため、list の中身を + ;; 書き換える。 + (when (assoc "reply" post) + (setcdr + (assoc "reply" post) + (cdr (assoc (1- + (string-to-number + (pukiwiki-view-comment-form-text-input-get-replyno))) + (car (cdr (assoc "reply" post))))))))) + ((string= plugin "article") + (add-to-list 'post + (pukiwiki-view-comment-form-text-input-get-subject)) + (add-to-list 'post + (pukiwiki-view-comment-form-text-input-get-message)))))) + post)) + +(defun pukiwiki-view-comment-form-text-input-get-data (plugin) + (let (reply-no name-value msg-value subject-value name subject msg) + ;; plugin に応じて、以下の property を探す。 + ;; p*comment のとき: name, msg (comment) を探す。 + ;; article のとき : name, subject, message を探す。 + (save-excursion + (catch 'found + (while (setq next (previous-single-property-change (point) 'anchorhead)) + (goto-char next) + (cond + ;; name + ((and (eq 'form (get-text-property (point) 'anchortype)) + (setq name (get-text-property (point) 'name))) + (setq name-value name)) + ;; msg (comment) + ((and (eq 'form (get-text-property (point) 'anchortype)) + (setq msg (get-text-property (point) 'comment))) + (setq msg-value msg)) + ;; subject + ((and (eq 'form (get-text-property (point) 'anchortype)) + (setq subject (get-text-property (point) 'subject))) + (setq subject-value subject)) + ;; msg (message) + ((and (eq 'form (get-text-property (point) 'anchortype)) + (setq msg (get-text-property (point) 'message))) + (setq msg-value msg))) + (when (or (and name-value msg-value) + (and name-value subject-value msg-value)) + (throw 'found t))))) + + (setq ret (list (cons "name" name-value) + (cons "msg" msg-value))) + (when subject-value (setq ret (cons (cons "subject" subject-value) ret))) + + ;; reply-no を探す。 + (when (string= plugin "pcomment") + (save-excursion + (let ((start (previous-single-property-change (point) 'pcomment-start)) + (end (previous-single-property-change (point) 'pcomment-end)) + next no) + (goto-char start) + (while (< (setq next (next-single-property-change + (point) 'anchorhead nil end)) end) + (progn + (goto-char next) + (cond + ;; reply-no + ((and (eq 'radio (get-text-property (point) 'anchortype)) + (setq no (get-text-property (point) 'radio)) + (eq 'yes (get-text-property (point) 'select))) + (setq reply-no no)))))) + + (when reply-no + (add-to-list 'ret (cons "reply" reply-no))))) + ret)) + +(defvar pukiwiki-view-form-name-history nil) +(defvar pukiwiki-view-form-comment-history nil) +(defvar pukiwiki-view-form-subject-history nil) +(defvar pukiwiki-view-form-message-history nil) +(defun pukiwiki-view-comment-form-text-input-get-name () + (let* ((name-default pukiwiki-view-comment-form-name-default) + (ret (cons "name" + (read-string + (if name-default + (format "Name (%s): " name-default) + (format "Name : ")) + nil 'pukiwiki-view-form-name-history name-default)))) + (message nil) + ret)) + +(defun pukiwiki-view-comment-form-text-input-get-comment () + (let ((ret (cons "msg" (read-string "Comment: " nil + 'pukiwiki-view-form-comment-history + nil)))) + (message nil) + ret)) + +(defun pukiwiki-view-comment-form-text-input-get-subject () + (let ((ret + (cons "subject" (read-string "Subject: " nil + 'pukiwiki-view-form-subject-history + nil)))) + (message nil) + ret)) + +(defun pukiwiki-view-comment-form-text-input-get-message () + (let ((ret + (cons "msg" (read-string "Message: " nil + 'pukiwiki-view-form-message-history + nil)))) + (message nil) + ret)) + +(defun pukiwiki-view-comment-form-text-input-get-str-from-buffer + (buf pos type) + (let ((ibuf (generate-new-buffer "*pukiwiki view form textarea*")) + (obuf buf) (opos pos) + (current-window (selected-window))) + ;; create buffer of text area. + (set-buffer ibuf) + (pukiwiki-view-form-textarea-mode) + + ;; set up local variables. + (setq pukiwiki-view-form-textarea-orig-buf obuf) + (setq pukiwiki-view-form-textarea-orig-pos opos) + (setq pukiwiki-view-form-textarea-orig-type type) + (setq + pukiwiki-view-form-textarea-orig-wincfg (current-window-configuration)) + + ;; split window. + (let ((height (- (window-height current-window) + pukiwiki-view-form-textarea-buffer-height))) + (split-window current-window (max window-min-height height)) + (select-window (next-window)) + (switch-to-buffer ibuf)))) + +(defun pukiwiki-view-comment-form-text-input-get-replyno () + (let ((ret (read-string "Reply No: " nil t nil))) (message nil) ret)) + +(defun pukiwiki-view-comment-form-insert (form-type) + (let* ((type form-type) + (add (cond + ((eq type 'comment) pukiwiki-view-form-elem-comment-list) + ((eq type 'pcomment) pukiwiki-view-form-elem-pcomment-list) + ((eq type 'article) pukiwiki-view-form-elem-article-list) + ((eq type 'all) (apply 'append + pukiwiki-view-form-elem-comment-list + pukiwiki-view-form-elem-pcomment-list + pukiwiki-view-form-elem-article-list)))) + (list (append pukiwiki-view-form-elem-list add)) + reply-list) + ;; form data を取って来る。 + (setq result-list nil) + (let ((form-list (pukiwiki-view-form-data-get)) + ret-list) + (setq result-list + (mapcar + (lambda (form) + (let (pos key val ret (reply-count 0)) + (while + ;; key . value の pair を検索。 + (string-match + "\\s-+\\([a-zA-Z0-9_]+\\)=\"\\([^\"]+\\)\"" + form pos) + (setq pos (match-end 0)) + ;; pair が揃ったかチェック。 + (cond + ((string= (match-string 1 form) "name") + (setq key (match-string 2 form))) + ((string= (match-string 1 form) "value") + (setq val (match-string 2 form)))) + (when (and key val) + ;; pair が揃ったら cons にして返す。 + ;; `reply' は nest させる。 + (if (string= key "reply") + (progn + (setq reply-list + (cons (cons reply-count val) reply-list)) + (setq reply-count (1+ reply-count))) + (setq ret (cons (cons key val) ret))) + (setq key nil + val nil))) + ;; reply の分を ret に。 + (when reply-list + (setq ret (cons (cons "reply" (list reply-list)) ret)) + (setq reply-list nil)) + ret)) form-list)) + + ;; comment, pcomment 以外の form を除外する。 + (setq result-tmp-list result-list) + (setq result-list nil) + (while (setq form-elems (car result-tmp-list)) + (when (string-match "\\(p*comment\\|article\\)" + (cdr (assoc "plugin" form-elems))) + (setq result-list (cons form-elems result-list))) + (setq result-tmp-list (cdr result-tmp-list))) + ;; (setq result-list (nreverse result-list)) + (ignore)) + + ;; バッファへの設定。 + (pukiwiki-view-comment-form-insert-subr result-list) + )) + +(defun pukiwiki-view-comment-form-insert-subr (list) + (let ((elements-list list) plugin-type) + (save-excursion + (goto-char (point-min)) + ;;;;;; (switch-to-buffer (current-buffer)) ;;;;; for degug. + (while (re-search-forward + "^#\\(p*comment\\|article\\)\\(([^)]*)\\)*$" + nil t) + (setq plugin-type (match-string 1)) + (forward-line 1) + (when pukiwiki-view-form-text-input-style + (cond + ((or (eq pukiwiki-view-form-text-input-style 'form) + (eq pukiwiki-view-form-text-input-style 'large)) + ;; name input. + (insert "\n\n") + (forward-line -1) + (pukiwiki-view-comment-form-insert-input 'name "") + (cond + ((string-match "p*comment" plugin-type) + ;; comment input. + (insert "\n") + (forward-line -1) + (pukiwiki-view-comment-form-insert-input 'comment "")) + ((string= plugin-type "article") + ;; subject input. + (insert "\n") + (forward-line -1) + (pukiwiki-view-comment-form-insert-input 'subject "") + ;; message (comment-extra) input. + (insert "\n") + (forward-line -1) + (pukiwiki-view-comment-form-insert-input 'message "")) + (t nil))) + (t nil)) + ;; submit button. + (insert (concat " [" + (let ((elem (car elements-list))) + (or (cdr (assoc (cdr (assoc "plugin" elem)) elem)) + "コメントの挿入")) ; pcomment の時だけ変だ。 + "]\n\n")) + (forward-line -2) + (pukiwiki-view-comment-form-insert-property-set + (car elements-list) 'button 2) + (setq elements-list (cdr elements-list))) + )))) + +(defun pukiwiki-view-comment-form-insert-input (type data) + (let* ((prefix " ") ; 段落整形されてしまってフォーマットが + ; 崩れてしまうため、整形済みテキストと + ; 認識させるために必要。 + (prompt (cond ((eq type 'name) "名前 ") + ((eq type 'comment) "コメント ") + ((eq type 'subject) "題名 ") + ((eq type 'message) "記事 "))) + (len (cond ((eq type 'name) + pukiwiki-view-comment-form-name-field-width) + ((eq type 'comment) + pukiwiki-view-comment-form-comment-field-width) + ((eq type 'subject) + pukiwiki-view-comment-form-subject-field-width) + ((eq type 'message) + pukiwiki-view-comment-form-message-field-width))) + (str (if data + (format (concat "%-" (number-to-string len) "s") data) + (make-string len ? ))) + (offset (length (concat prefix prompt)))) + + ;; バッファへの表示データに改行が含まれていれば無効に。 + (while (string-match "\n+" str) + (setq str (replace-match "" nil nil str))) + ;; コメントの場合は、保持するデータに含まれる改行も無効に。 + (when (eq type 'comment) + (while (string-match "\n+" data) + (setq data (replace-match "" nil nil data)))) + + (when (> (string-width str) len) + (setq str (pukiwiki-truncate-string str len))) + (insert (concat prefix prompt "[" str "]")) + (pukiwiki-view-comment-form-insert-property-set data type offset))) + +(defun pukiwiki-truncate-string (str width) + "pukiwiki-mode 用の truncate-string. + +STR で指定された文字列の先頭から、WIDTH で指定された流さ分の文字列を +取り出して返します。端数が発生した場合は、空白をパディングします。" + + (let ((start 0) (end 1) (index 0) (len 0) ret-str rest) + (catch 'length-over + (while (setq c (substring str start end)) + (if (<= (setq len (+ (char-width (aref c index)) len)) width) + (progn + (if ret-str + (setq ret-str (format "%s%s" ret-str c)) + (setq ret-str (format "%s" c))) + (setq rest (- width len)) + (setq start (1+ start)) + (setq end (1+ start))) + (throw 'length-over t)))) + (if rest + (setq ret-str (format "%s%s" ret-str (make-string rest ? )))) + ret-str)) + +(defun pukiwiki-view-comment-form-insert-property-set (str type offset) + (let ((start (+ (line-beginning-position) offset)) + (end (line-end-position)) + (prop (or str ""))) + ;; text property set. + (add-text-properties start end + (list 'anchor t 'anchortype 'form + type prop) nil) + (add-text-properties (1+ start) (+ start 2) (list 'anchorhead t) nil) + ;; overlay set. + (setq ovr (make-overlay start end)) + (overlay-put ovr 'face 'pukiwiki-view-button-face) + (overlay-put ovr 'priority 1) + (goto-char end)) + (forward-line 1)) + +(defvar pukiwiki-view-comment-form-reply-level 2 + "The level of comment to enable reply.") + +(defun pukiwiki-view-comment-form-pcomment-reformat () + (save-excursion + (let* ((reg-end (point)) + (reg-start (progn + (re-search-backward "^#pcomment" nil t) + (point))) + (reply-no 0) + mark) + (narrow-to-region reg-start reg-end) + + ;; pcomment 挿入部分の開始位置設定。 + (goto-char (point-min)) + (add-text-properties (point) (1+ (point)) + (list 'pcomment-start t) nil) + + (while (re-search-forward "^\\(\\s-*\\)\\(_\\)" nil t nil) + ;; level 2 までだけ変換。 + (when (< (length (match-string 1)) + (1+ (* pukiwiki-view-comment-form-reply-level 2))) + (setq reply-no (1+ reply-no)) + (let* ((start (match-beginning 2)) + (end (match-end 2))) + ;; 行頭部分の記号を置換。 + (cond + ((or (eq pukiwiki-view-form-text-input-style 'form) + (eq pukiwiki-view-form-text-input-style 'large)) + (setq mark " ")) + ((eq pukiwiki-view-form-text-input-style 'ask) + (setq mark (number-to-string reply-no))) + (t nil)) + (replace-match (concat "[" mark "]") t nil nil 2) + ;; property, overlay を設定。 + (cond + ((or (eq pukiwiki-view-form-text-input-style 'form) + (eq pukiwiki-view-form-text-input-style 'large)) + ;; 先に置換してしまうので、point を調整。 + (let ((start (1+ start)) + (end (1+ end))) + ;; property set. + (pukiwiki-set-content-anchor-property + start end 'radio reply-no nil 0 'select 'no) + ;; overlay set. + (setq ovr (make-overlay start end)) + (overlay-put ovr 'face 'pukiwiki-view-button-face) + (overlay-put ovr 'priority 1))))))) + + ;; pcomment 挿入部分の終了位置設定。 + (goto-char (point-max)) + (add-text-properties (1- (point)) (point) + (list 'pcomment-end t) nil) + (widen)))) + +(defun pukiwiki-view-form-data-get () + "form data を取って来る。" + + (let* ((pagename + (if (string= major-mode 'pukiwiki-index-mode) + (nth 1 (pukiwiki-index-page-info-current-line)) + pukiwiki-pagename)) + (url nil) + (site-info pukiwiki-site-info) + (site-url (pukiwiki-site-url)) + (site-name (car pukiwiki-site-info)) + buf) + (message "Getting form data...") + + ;; 表示形式のソースを取得し、バッファを生成。 + (setq current-buffername (concat " *pukiwiki form tmp*")) + (let* ((url site-url) + (pukiwiki-auto-insert nil)) + + (setq form-list nil) + + ;; form data の抽出。 + (save-current-buffer + (setq buf (pukiwiki-view-comment-form-create-buffer + url pagename site-info current-buffername)) + (set-buffer buf) (goto-char (point-min)) - (when (re-search-forward "^#pcomment(reply[ ]*,\\([^),]+\\))" nil t) - (message "Inserting comment...") - (setq comment - (pukiwiki-fetch-source - (buffer-substring-no-properties - (match-beginning 1) (match-end 1)) - (pukiwiki-site-url pukiwiki-site-info) - (pukiwiki-site-coding-system pukiwiki-site-info))) - (forward-line 1) - (if (cdr (assoc 'body comment)) - (pukiwiki-insert-comment-str (cdr (assoc 'body comment)))) - (pukiwiki-replace-entity-refs) - ))) - (message "Inserting comment...done!"))) + (if (catch 'end-tag-nothing + (while (re-search-forward "
" nil t) + (throw 'end-tag-nothing t)) + (setq end (match-end 0)) + (setq form-list + (cons (buffer-substring-no-properties start end) + form-list)))) + (progn (setq error-flag t) + (message "form tag no match!")))) + (kill-buffer buf) + + (message "Getting form data... done.") + form-list))) + +(defun pukiwiki-view-comment-form-create-buffer (url pagename site-info + buffername + &optional backup day) + (let ((raw backup) + get-buf content) + (setq get-buf + (pukiwiki-http-request + 'get "read" pagename url (pukiwiki-site-coding-system site-info))) + (set-buffer get-buf) + (setq content (buffer-substring-no-properties (point-min) (point-max))) + (setq temp-buf (generate-new-buffer buffername)) + (set-buffer temp-buf) + (insert content) + temp-buf)) (defun pukiwiki-insert-contents () "目次を挿入する" @@ -2697,17 +4044,372 @@ (setq lst (cdr lst)))))))) (defun pukiwiki-set-content-anchor-property (start end type value - &optional object) - (add-text-properties start end - (list 'anchor t 'anchortype type type value) - object) - (add-text-properties start (1+ start) (list 'anchorhead t) object)) + &optional object headoffset + &rest list) + (unless (get-text-property start 'anchortype) + (let (pos) + (when (> end + (setq pos (or (next-single-property-change start 'anchortype) + end))) + (setq end pos))) + (add-text-properties start end + (list 'anchor t 'anchortype type type value) + object) + (when list + (let ((arg list)) + (while (setq type (car arg)) + (setq arg (cdr arg)) + (setq value (car arg)) + (setq arg (cdr arg)) + (add-text-properties start end (list type value) object)))) + + (if headoffset + (setq headstart (+ start headoffset)) + (setq headstart start)) + (add-text-properties headstart (1+ headstart) (list 'anchorhead t) object))) + +(defun pukiwiki-set-content-chip-away-property-at () + (let ((pos (goto-char (point-min))) prop type) + (save-excursion + (while (setq pos (next-single-property-change pos 'anchorhead nil nil)) + (when (or (and (= (char-after pos) ?\n) + (get-text-property pos 'anchorhead)) + (and (= (char-after pos) ? ) + (get-text-property pos 'anchorhead) + (get-text-property (1+ pos) 'anchorhead) + (eq (setq type (get-text-property pos 'anchortype)) + (get-text-property (1+ pos) 'anchortype)) + (eq (get-text-property pos type) + (get-text-property (1+ pos) type)))) + ;; delete overlay from invalid point. + (let ((overlays (overlays-in pos (1+ pos)))) + (while + (setq ovr (prog1 (car overlays) (setq overlays (cdr overlays)))) + (when (overlay-get ovr 'overlay) + (move-overlay ovr + (1+ (overlay-start ovr)) (overlay-end ovr))))) + ;; delete properties from invalid point. + (set-text-properties pos (1+ pos) nil)))))) + +;; 設定の切り替えに使用する。 +(defvar pukiwiki-view-local-variables + (list '(pukiwiki-jump-display-window-top . 0) + '(pukiwiki-jump-display-window-top-without-content . 1) + '(pukiwiki-jump-display-window-top-only-header . 2) + '(pukiwiki-jump-display-window-upper-margin . 3) + '(pukiwiki-jump-display-window-top-skip-visible-url . 4))) + +(defun pukiwiki-view-local-style-set (&optional arg) + (interactive "P") + (message + "Select Style: D)efault L)Page feed by Link H)Page feed by Header Q)uit") + (let ((c (downcase (read-char))) + quit) + (cond + ((= c ?d) (setq list nil)) ; 初期設定に戻す。 + ((= c ?l) (setq list '(t t nil 2 t))) ; リンクアンカーでページ送りモード。 + ((= c ?h) (setq list '(t t t 1 nil))) ; 見出しアンカーでページ送りモード。 + ((= c ?q) (progn (setq list nil) (setq quit t))) ; 終了。 + (t (setq quit t))) + + (if quit + (message "quit.") + (unless (local-variable-p + (car (car pukiwiki-view-local-variables)) (current-buffer)) + (mapcar (lambda (cell) (make-local-variable (car cell))) + pukiwiki-view-local-variables)) + + ;; バッファローカル変数に束縛。 + (if (null list) + ;; 初期値に戻すために、バッファローカル変数を削除。 + (mapcar 'kill-local-variable + (mapcar 'car pukiwiki-view-local-variables)) + (mapcar (lambda (cell) (set (car cell) (nth (cdr cell) list))) + pukiwiki-view-local-variables)) + + (message (concat + "view style to <" + (cond + ((= c ?l) "Page feed by Link") + ((= c ?h) "Page feed by Header") + ((= c ?n) "Nomal")) + "> style."))))) + +;; page history of pukiwiki-view-mode. +(defvar pukiwiki-view-jump-page-history nil + "簡易履歴のリスト。") +(defvar pukiwiki-view-jump-page-history-push-inhibit nil + "履歴への push を抑制する変数。 +履歴を戻る動作のとき t に束縛する。それ以外は nil のまま。") + +(defun pukiwiki-view-jump-page-history-push (name pos inf) + (when (and (not (and + (string= name (car (car pukiwiki-view-jump-page-history))) + (= pos (cadr (car pukiwiki-view-jump-page-history))))) + (not (string= name pagename))) + (let ((history (cons (list name pos inf) pukiwiki-view-jump-page-history)) + (inhibit pukiwiki-view-jump-page-history-push-inhibit)) + (when (and (not inhibit) name pos) + (setq pukiwiki-view-jump-page-history history) + ;; 履歴保持の最大数を超えたら、最古のものから削除する。 + (when (> (length pukiwiki-view-jump-page-history) + pukiwiki-view-jump-page-history-keep-count) + (setq pukiwiki-view-jump-page-history + (nreverse + (cdr (nreverse pukiwiki-view-jump-page-history))))))))) + +(defun pukiwiki-view-jump-page-history-pop () + (let ((history (car pukiwiki-view-jump-page-history))) + (setq pukiwiki-view-jump-page-history + (cdr pukiwiki-view-jump-page-history)) + history)) + +(defvar pukiwiki-command-at-index nil + "displary page 関連コマンドが index buffer で実行された場合だけ t になる。") + +(defun pukiwiki-index-view-backward-page () + (interactive) + (let ((pukiwiki-command-at-index t)) + (other-window 1) + (pukiwiki-view-backward-page))) + +(defun pukiwiki-view-backward-page () + (interactive) + (let* ((history-info (pukiwiki-view-jump-page-history-pop)) + (page-info (cons (car history-info) (car (cdr history-info)))) + (site-info (car (cddr history-info))) + (name (car page-info)) + (pos (cdr page-info)) + (pukiwiki-view-jump-page-history-push-inhibit t)) + (if history-info + (pukiwiki-view-display-page name pos site-info) + (message "history is empty.")))) + +(defadvice pukiwiki-display-page (around + pukiwiki-view-jump-page-advice-around + activate) + (let ((blist (buffer-list)) + prev buf name pos inf) + (if (catch 'found + (while (setq buf (car blist)) + (save-excursion + (set-buffer buf) + (if (string-match "Pukiwiki View" mode-name) + (throw 'found t) + (setq blist (cdr blist)))))) + (setq prev buf)) + (when prev + (save-excursion + (set-buffer prev) + ;; 関数本体の実行後に push する情報を保持。 + (setq name pukiwiki-pagename) + (setq pos (point)) + (setq inf pukiwiki-site-info))) + + ;; pukiwiki-display-page + ad-do-it + + (let ((ret ad-return-value)) + (if (and ret name pos inf) + (unless pukiwiki-view-jump-page-history-push-inhibit + ;; 正常に表示でき、inhibit でなければ、履歴を push する。 + ;; 今のところ、inhibit なのは backward のときのみ。 + (pukiwiki-view-jump-page-history-push name pos inf)))))) + +(defun pukiwiki-view-goto-page (&optional pagename) + "ページを表示する。" + (interactive) + (let ((page pagename)) + (unless page + (setq page + (pukiwiki-read-pagename + (or (get-text-property (point) 'pagename) + (pukiwiki-word-at-point) + "") + (pukiwiki-site-name)))) + + (pukiwiki-view-display-page-wrap page))) + +(defun pukiwiki-view-display-page-wrap (pagename) + + (let ((page pagename) + (replacement pukiwiki-pagename)) + ;; 相対指定なら完全指定に。 + (when (string-match "^\\.[./]*" pagename) + (setq len (- (match-end 0) (match-beginning 0))) + (save-match-data + (if (< len 3) + (setq replacement + (concat (pukiwiki-view-chip-path replacement 0) "/")) + (setq replacement + (pukiwiki-view-chip-path replacement (/ len 3))))) + (when replacement + (setq page (replace-match replacement nil nil pagename))) + (when (string-match "/+$" page) + (setq page (replace-match "" nil nil page)))) + + ;; 2004.09.26 InterWikiName + (setq iwn-site-info nil) + (when (string-match "^\\([^:]+\\):\\(.+\\)$" page) + (setq interwikiname (match-string 1 page)) + (setq page (match-string 2 page)) + (setq iwn-site-info + (assoc interwikiname + (pukiwiki-view-get-localvarialbe-from-index-buffer + pukiwiki-site-info + 'pukiwiki-index-interwiki-info-list)))) + + (if (string-match "^\\([^#]+\\)#\\(.+\\)$" page) + (progn (setq pname (match-string 1 page)) + (setq aname (match-string 2 page)) + (unless (string= pname pukiwiki-pagename) + (pukiwiki-view-display-page pname 1 iwn-site-info)) + (pukiwiki-view-jump-to-aname aname)) + (pukiwiki-view-display-page page 1 iwn-site-info)))) + +(defun pukiwiki-view-chip-path (path count) + "階層構造のページ名から、最下位の指定された数の page name を削ぎ落し +た path を返します。" + + (let ((start 0) idx-list) + (while (string-match "/" path start) + (setq idx-list (cons (match-end 0) idx-list)) + (setq start (match-end 0))) + (setq idx-list (cons (length path) idx-list)) + + (if (> (length idx-list) count) + (substring path 0 (nth count idx-list)) + ""))) + +(defun pukiwiki-word-at-point () + "ポイント位置の単語を返す。" + (save-excursion + (progn (forward-word 1) ; 補正。 + (forward-word -1)) + (buffer-substring-no-properties (point) (progn (forward-word 1) (point))))) + +(defun pukiwiki-view-get-localvarialbe-from-index-buffer (site-info val) + "当該 view buffer が属する site の情報を、index buffer から取得する。" + + (let ((info site-info) + (buf (pukiwiki-index-get-buffer-create site-info))) + (save-current-buffer + (save-excursion + (set-buffer buf) + (eval val))))) + +(defun pukiwiki-view-display-page (page-name &optional + position goto-site-info refetch) + "指定されたページ名のページを表示する。 + +REFETCH が nil ですでにバッファが存在するなら、HTTP GET しない。" + (let ((site-info (or goto-site-info pukiwiki-site-info)) + (info-list pukiwiki-index-page-info-list) + (attach-list pukiwiki-index-attach-list) + (pagename page-name) + ;;;;;;;;;; (prev-page pukiwiki-pagename) + (pos position) + search-word) + (catch 'faild-get + (progn + (when site-info + (unless (pukiwiki-display-page pagename site-info refetch) + (message nil) + (throw 'faild-get t)) + (unless (string-match "Pukiwiki View" mode-name) + ;; 既に pukiwiki-view-mode なら、既存バッファへの移動なので、 + ;; 整形処理は行なわないで良い。 + (pukiwiki-view-mode) + + (setq pukiwiki-prev-buffer nil) + (setq pukiwiki-pagename pagename) + (setq pukiwiki-site-info site-info) + (setq pukiwiki-index-page-info-list info-list) + (setq pukiwiki-index-attach-list attach-list) + (condition-case err + (if hi-lock-mode + () + (hi-lock-mode 1)) + (error + ())) + (if (and + search-word + (functionp 'hi-lock-face-buffer)) + (hi-lock-face-buffer search-word 'region)) + + ;; 表示画面を整形 + (pukiwiki-view-reformating) + ) + + (set-buffer-modified-p nil) + (setq buffer-read-only t) + (if pos (goto-char pos) + (goto-char (point-min)) + ;;;;;;;;;; 2004.09.14 これはどうかな?? + ;;;;;;;;;; どうしても current-face が消えないんだが。 + (run-hooks 'pukiwiki-index-post-command-hook))) + + (when (not pukiwiki-command-at-index) (setq view-buf (current-buffer))) + (other-window 1) + + (pukiwiki-index site-info nil pagename) + (pukiwiki-view-set-index-current-line pagename) + + (when (not pukiwiki-command-at-index) + (run-hooks 'pukiwiki-index-post-command-hook) + (pop-to-buffer view-buf)) + )) + )) + +(defun pukiwiki-view-set-index-current-line (pagename) + (let ((site-info pukiwiki-site-info) + (page pagename) + (buf (pukiwiki-index-get-buffer-create site-info))) + (set-buffer buf) + (goto-char (point-min)) + (when pagename + (catch 'point-set + (dolist (elm pukiwiki-index-page-info-list) + (when (string= (nth 1 elm) pagename) + (re-search-forward (format "^%4d" (nth 0 elm))) + (beginning-of-line) + (recenter) + (throw 'point-set t))))))) (defun pukiwiki-view-return-function (&optional opt) (interactive) ;; anchor property が無ければ従来の動作を。 (if (pukiwiki-point-anchor-p) - (pukiwiki-jump-content-anchor) + (cond + ;; url. + ((pukiwiki-point-anchor-url-p) + (browse-url (get-text-property (point) 'url))) + ;; link of wiki. + ((pukiwiki-point-anchor-pagename-p) + (setq page (get-text-property (point) 'pagename)) + (pukiwiki-view-display-page-wrap page)) + ;; form button. + ((pukiwiki-point-anchor-form-buttom-p) + (pukiwiki-view-form-submit (get-text-property (point) 'button))) + ;; select radio button. + ((pukiwiki-point-anchor-form-radio-buttom-p) + (pukiwiki-view-form-select-radio-button + (get-text-property (point) 'select))) + ;; form input. + ((pukiwiki-point-anchor-form-input-name-p) ; name + (pukiwiki-view-form-input 'name (get-text-property (point) 'name))) + ((pukiwiki-point-anchor-form-input-comment-p) ; comment + (pukiwiki-view-form-input 'comment + (get-text-property (point) 'comment))) + ((pukiwiki-point-anchor-form-input-subject-p) ; subject + (pukiwiki-view-form-input 'subject + (get-text-property (point) 'subject))) + ((pukiwiki-point-anchor-form-input-message-p) ; message + (pukiwiki-view-form-input 'message + (get-text-property (point) 'message))) + + (t + (pukiwiki-jump-content-anchor))) (pukiwiki-edit-new-line))) (defun pukiwiki-view-return-contents (&optional opt) @@ -2721,6 +4423,52 @@ (goto-char (point-min)) (re-search-forward "^#contents" nil t))) +(defun pukiwiki-point-anchor-url-p () + (let* ((atype (get-text-property (point) 'anchortype)) + (type (get-text-property (point) 'anchor))) + (when (and type (eq atype 'url)) t))) + +(defun pukiwiki-point-anchor-pagename-p () + (let* ((atype (get-text-property (point) 'anchortype)) + (type (get-text-property (point) 'anchor))) + (when (and type (eq atype 'pagename)) t))) + +(defun pukiwiki-point-anchor-form-buttom-p () + (let* ((atype (get-text-property (point) 'anchortype)) + (type (get-text-property (point) 'anchor)) + (button (get-text-property (point) 'button))) + (when (and type (eq atype 'form)) t) button)) + +(defun pukiwiki-point-anchor-form-radio-buttom-p () + (let* ((atype (get-text-property (point) 'anchortype)) + (type (get-text-property (point) 'anchor)) + (radio (get-text-property (point) 'radio))) + (when (and type (eq atype 'form)) t) radio)) + +(defun pukiwiki-point-anchor-form-input-name-p () + (let* ((atype (get-text-property (point) 'anchortype)) + (type (get-text-property (point) 'anchor)) + (name (get-text-property (point) 'name))) + (when (and type (eq atype 'form)) t) name)) + +(defun pukiwiki-point-anchor-form-input-comment-p () + (let* ((atype (get-text-property (point) 'anchortype)) + (type (get-text-property (point) 'anchor)) + (comment (get-text-property (point) 'comment))) + (when (and type (eq atype 'form)) t) comment)) + +(defun pukiwiki-point-anchor-form-input-subject-p () + (let* ((atype (get-text-property (point) 'anchortype)) + (type (get-text-property (point) 'anchor)) + (subject (get-text-property (point) 'subject))) + (when (and type (eq atype 'form)) t) subject)) + +(defun pukiwiki-point-anchor-form-input-message-p () + (let* ((atype (get-text-property (point) 'anchortype)) + (type (get-text-property (point) 'anchor)) + (message (get-text-property (point) 'message))) + (when (and type (eq atype 'form)) t) message)) + (defun pukiwiki-jump-content-anchor-1 (type value &optional object) (let ((prev (point)) (type type) (value value) dest) (goto-char (point-min)) @@ -2754,6 +4502,30 @@ (defun pukiwiki-point-anchor-content-p () (eq 'content (get-text-property (point) 'anchortype))) +(defun pukiwiki-point-anchor-header-p () + (eq 'header (get-text-property (point) 'anchortype))) + +(defun pukiwiki-jump-anchor-window-top-prev (&optional opt) + (interactive "P") + (pukiwiki-jump-anchor-window-top t)) + +(defun pukiwiki-jump-anchor-window-top (&optional opt) + (interactive "P") + (let ((ignore pukiwiki-jump-display-window-top-skip-visible-url) + start) + (catch 'found + (while (pukiwiki-jump-anchor opt) + (if ignore + (unless (string-match "h*ttps*" (pukiwiki-word-at-point)) + (throw 'found t)) + (throw 'found t)))) + (when (or (null pukiwiki-jump-display-window-top-only-header) + (pukiwiki-point-anchor-header-p)) + (save-excursion + (forward-line (- 0 pukiwiki-jump-display-window-upper-margin)) + (setq start (point))) + (set-window-start (selected-window) start)))) + (defun pukiwiki-jump-anchor (&optional opt) (interactive "P") (let* ((way opt) dest) @@ -2761,7 +4533,9 @@ (setq jump-function 'next-single-property-change)) (if (setq dest (pukiwiki-search-point-of-destination jump-function 'anchorhead)) - (goto-char dest)))) + (goto-char dest) + (if (and way (get-text-property (point-min) 'anchorhead)) + (goto-char (point-min)))))) (defun pukiwiki-jump-anchor-prev (&optional opt) (interactive "P") @@ -2821,44 +4595,65 @@ (defun pukiwiki-text-reformating () "表示の時に読みやすいように適当なところで折り返すなどの処理を行う" - (let ((pt) (end-pt) (reg "^[^ *->#\n\r]+[^\n\r]*$") str) + (let ((pt) (end-pt) (reg "^[^ *->#\n\r]+[^\n\r]*$") str match) (goto-char (point-min)) - (while (re-search-forward "^\\(.\\).*\\(\\s-*[~]+\\s-*[\n\r]\\)" nil t) + (while (re-search-forward + "^\\(.\\).*\\(\\s-*[~]+\\(\\s-*[\n\r]\\)\\)" nil t) + (setq match (match-string 2)) (delete-region (match-beginning 2) (match-end 2)) (setq line-beginning-char (buffer-substring-no-properties (match-beginning 1) (match-end 1))) (cond - ((string-match "[-+>]" line-beginning-char) + ((string-match "[-+]" line-beginning-char) (insert "\n~")) + ((string-match "[>]" line-beginning-char) + (insert inner-line-feed-mark) + (and + (string-match "[\n\f][\n\f]+" match) + (insert "\n"))) ((string-match "[ |*#]" line-beginning-char) (insert "\n")) (t - (insert inner-line-feed-mark))) + (insert inner-line-feed-mark) + (and + (not (eq (point) (point-max))) + (string-match "[-+ *<\t\n\f]" + (buffer-substring-no-properties (point) (1+ (point)))) + (insert "\n")))) (beginning-of-line)) ;; 定義を読みやすく処理 (goto-char (point-min)) - (pukiwiki-replace-regexp "^:\\([^|\n\r]+\\)|\\([^\n\r]+\\)$" - "\\1\n\n\t\\2\n" nil (point-min) (point-max)) + (pukiwiki-replace-regexp "^:\\([^|\n\r]+\\)|\\([^\n\r]*\\)$" + "\n\\1\n\n\t\\2\n" nil (point-min) (point-max)) ;; コメントを読みやすく処理 (goto-char (point-min)) (while (re-search-forward - "^[-]+\\([^\n\r]+\\)[ ]*--[ ]*[^\n\r]+[0-9]+-[0-9]+-[0-9]+[^\n\r]+" + (concat + "^[-]+\\([^\n\r]+\\)[ ]*--[ ]*[^\n\r]+\\(" + (mapconcat 'identity pukiwiki-view-comment-date-regexp "\\|") + "\\)[^\n\r]+") nil t) (setq pt (line-beginning-position)) (if (re-search-forward "\\(^$\\|^[^-\n\r]+\\)" nil t) (setq end-pt (- (line-beginning-position) 1)) (setq end-pt (point-max))) - (setq str - (buffer-substring-no-properties - pt end-pt)) - (delete-region pt end-pt) - (insert "\n") - (pukiwiki-insert-comment-str str) - (insert "\n")) + (pukiwiki-insert-comment-str nil pt end-pt)) + + ;; 2004.09.16 コメントフォームの挿入。 + (unless (string-match "pukiwiki\\s-+[^\\s-]+\\s-+tmp" + (buffer-name (current-buffer))) + (let ((flag nil)) + (save-excursion + (goto-char (point-min)) + (when (re-search-forward + "^#\\(p*comment\\|article\\)\\(([^)]*)\\)*$" nil t) + (setq flag t))) + (when flag + (pukiwiki-view-comment-form-insert 'all)))) (goto-char (point-min)) (while (re-search-forward @@ -2904,7 +4699,11 @@ (setq pos (point)))) (setq pt (line-beginning-position)) (if (re-search-forward - "^[-+ |*>#~]+[^\n\r]*$" nil t) + ;; 以下も段落開始と認識させる様に追加。 + ;; - 行頭の `/' (コメント行: 一つだけだけど) + ;; - 行頭の `_' (整形されたコメント) + ;; - 行頭の `:' (定義リスト) + "^[-+ |*>#~/_:]+[^\n\r]*$" nil t) (setq end-pt (line-beginning-position)) ;;(line-end-position)) (setq end-pt (point-max)) (goto-char (point-max))) @@ -2914,12 +4713,22 @@ (defvar inner-line-feed-mark "%%%INNER-LINE-FEED%%%") (defun pukiwiki-fill-region-paragraph (top bottom &optional delimited) - (let ((regexp (concat (or delimited inner-line-feed-mark) "\\s-*[\n\r]?")) + (let ((regexp (or delimited inner-line-feed-mark)) (fill-start-point top) (fill-limit-point (make-marker)) - (limit bottom)) + (limit bottom) + indent prev-mark) (set-marker fill-limit-point limit) (goto-char fill-start-point) + + ;; この段落の種類を確認し、必要ならインデント量を得る。 + (save-excursion + (when (eq ?\ (char-after (point))) + (re-search-forward "^[ ]+" nil t) + (setq indent (length (match-string 0)))) + (forward-line -1) + (setq prev-mark (char-after (point)))) + (catch 'range-over (while (setq result (re-search-forward regexp fill-limit-point t)) (setq fill-end-point (match-beginning 0)) @@ -2929,7 +4738,8 @@ (fill-region fill-start-point fill-end-point) (if (>= (point) fill-limit-point) (throw 'range-over t) - (setq fill-start-point (point)))) + (setq fill-start-point (point)) + (when indent (insert (make-string indent ?\ ))))) (cond ((>= (point) fill-limit-point) (throw 'range-over t)) ((eq result nil) @@ -2937,6 +4747,19 @@ (fill-region (point) fill-limit-point) (goto-char fill-limit-point)) (throw 'range-over t)))) + (save-excursion + (when (and (not (eq ?\_ (char-after top))) + (not (and (eq ?\/ (char-after top)) + (not (eq ?\_ (char-after (point))))))) + (when (and (not (eq top (point-min))) + (not (eq ?\- prev-mark)) + (not (eq ?\> prev-mark))) + (goto-char top) (insert "\n")) + (goto-char fill-limit-point) (insert "\n")) + (when (and (eq ?\_ (char-after top)) + (eq ?\- prev-mark)) + (goto-char top) (insert "\n")) + ) (set-marker fill-limit-point nil))) (defun pukiwiki-insert-attach-file-list () @@ -2965,8 +4788,8 @@ (goto-char (point-min)) (while (re-search-forward (if pukiwiki-auto-insert - "COLOR(\\([^)]+\\)){\\([^}]+\\)}" - "COLOR(\\([^)]+\\)){\\([^}\n\r]+\\)}") + "&*COLOR(\\([^)]+\\)){\\([^}]+\\)};*" + "&*COLOR(\\([^)]+\\)){\\([^}\n\r]+\\)};*") nil t) (setq color (match-string 1)) (setq str (match-string 2)) @@ -2984,27 +4807,48 @@ (intern color)) (cons (cons 'background-color "white") (cons 'foreground-color color)))) - (overlay-put ov 'priority 0))))) + (overlay-put ov 'priority 2))))) -(defun pukiwiki-set-bold () +(defun pukiwiki-set-bold (&optional strikethru) (goto-char (point-min)) - (let ((start nil) (str nil) (ov nil)) + (let* ((start nil) (str nil) (ov nil) (reg-start 0) + (regexp (if pukiwiki-auto-insert + "\\([']['][']?\\)\\([^']*\\)\\([']['][']?\\)" + "\\([']['][']?\\)\\([^'\n\r]*\\)\\([']['][']?\\)")) + (regexp (if strikethru + (progn + (while (setq reg-start + (string-match "'" regexp reg-start)) + (setq regexp (replace-match "%" nil nil regexp)) + (setq reg-start (1+ reg-start))) + regexp) + regexp)) + (face (if strikethru 'pukiwiki-view-strikethru-face 'bold))) (while (re-search-forward - (if pukiwiki-auto-insert - "\\(['][']+\\)\\([^']+\\)\\(['][']+\\)" - "\\(['][']+\\)\\([^'\n\r]+\\)\\(['][']+\\)") + regexp nil t) - (setq start (match-string 1)) - (setq str (match-string 2)) - (delete-region (match-beginning 0) - (match-end 0)) - (insert str) - (setq ov (make-overlay (match-beginning 0) - (point))) - (if (= 2 (length start)) - (overlay-put ov 'face 'bold) - (overlay-put ov 'face 'italic)) - (overlay-put ov 'priority 0)))) + ;; 二個以上連続した改行 (空行) を超えることは許可しない。 + ;; つまり、段落を超えての強調は許可しない。 + (catch 'next + (let ((mstr (match-string 0))) + (save-match-data + (when (string-match "[\n\r][\n\r]+" mstr) + (throw 'next t)))) + (setq start (match-string 1)) + (setq str (match-string 2)) + ;; 全部消してしまうと anchor の overlay が無効になってしまうので、 + ;; 引用符の部分だけを削除する。 + (delete-region (match-beginning 3) + (match-end 3)) + (delete-region (match-beginning 1) + (match-end 1)) + + (setq ov (make-overlay (match-beginning 0) + (point))) + (if (= 2 (length start)) + (overlay-put ov 'face face) + (overlay-put ov 'face 'italic)) + (overlay-put ov 'priority 1))))) (defun pukiwiki-set-justification () (interactive) @@ -3041,13 +4885,13 @@ (defun pukiwiki-insert-cite () (interactive) (goto-char (point-min)) - (let ((str nil) - (page-delimiter "^ ") - (paragraph-start (concat page-delimiter "\\|[ \t]*$")) - (paragraph-start - (if (eq ?^ (aref paragraph-start 0)) - (substring paragraph-start 1))) - (paragraph-separate paragraph-start)) + (let* ((str nil) + (page-delimiter "^ ") + (paragraph-start (concat page-delimiter "\\|^>+\\|^[ \t]*$")) + (paragraph-start + (if (eq ?^ (aref paragraph-start 0)) + (substring paragraph-start 1))) + (paragraph-separate paragraph-start)) (while (re-search-forward "\\(^[>]+\\)" nil t) (setq str (length (match-string-no-properties 1))) (delete-region (match-beginning 0) @@ -3057,64 +4901,101 @@ (setq str (- str 1))) (beginning-of-line) (insert "\n") - (condition-case err - (fill-paragraph nil) - (error ()))))) + ;; putting overlay and filling region for part of citing. + (let ((start (point)) + (end (save-excursion + (re-search-forward paragraph-separate nil t) + (line-beginning-position)))) + ;; overlay set. + (setq ovr (make-overlay start end)) + (overlay-put ovr 'face 'pukiwiki-view-cite-face) + (overlay-put ovr 'priority 1) + ;; fill region. + (condition-case err + (pukiwiki-fill-region-paragraph + start end) + (error ())))))) (defvar pukiwiki-view-list-face 'font-lock-keyword-face) ; 外から指定可能に。 (defun pukiwiki-insert-list () (goto-char (point-min)) (let ((str nil) (level 1) (num 1)) - (while (re-search-forward "\\(^[-+]+\\)" nil t) - (setq str (length (buffer-substring-no-properties - (match-beginning 0) - (match-end 0)))) - (cond - ((> str 4) - ;; 何もしない。 - (ignore)) - ((and (= str 4) (= (line-end-position) (match-end 0))) - ;; 水平線に。 - (delete-region (match-beginning 0) (match-end 0)) - (insert-char ?\055 fill-column)) - (t - (delete-region (match-beginning 0) (match-end 0)) - (while (not (= str 1)) - (insert " ") - (setq str (- str 1))) - (insert "-"))) - (let ((fill-individual-varying-indent t) - (margin 2) - (paragraph-start "^\\($\\|[ ]*[-+]+\\)") - (paragraph-separate "^[ ]*[-+ <\t\n\f]") - (fill-end-position (make-marker))) - ;; filling. - (save-excursion - (unless (re-search-forward "^[ ]*[-+ <\t\n\f]" nil t nil) - ;; 以降に段落相当が無いので、これが最後のリスト項目と看倣す。 - (goto-char (point-max))) - (set-marker fill-end-position (- (line-beginning-position) 1))) - (save-excursion - ;; overlay set. - (setq ovr (make-overlay (line-beginning-position) fill-end-position)) - (overlay-put ovr 'face pukiwiki-view-list-face) - (overlay-put ovr 'priority 1) - ;; 左マージンを設定して、段落詰め込み。 - (set-left-margin (point) fill-end-position margin) - (condition-case err - (fill-individual-paragraphs (line-beginning-position) - fill-end-position t) - (error - (message "Error fill-individual-paragraphs: %s" - (error-message-string err))))) - (set-marker fill-end-position nil))))) + (while (re-search-forward "\\(^[-+]+\\)\\([ \t]*\\)" nil t) + (let* ((start (match-beginning 1)) + (end (match-end 1)) + (margin (1+ (- (match-end 2) end))) + (elem (match-string 0))) + + (setq str (length (buffer-substring-no-properties start end))) + (cond + ((and (>= str 4) + (string= elem + (buffer-substring + (line-beginning-position) (line-end-position)))) + ;; 水平線に。 + (delete-region (match-beginning 0) end) + (insert-char ?\055 fill-column)) + (t + ;; そのまま delete-region, insert だと、直後の property, overlay の + ;; 範囲に含まれてしまうので、少し調整する。 + (let ((len str)) + (goto-char start) + ;; 先に insert して、 + (while (not (= str 1)) + (insert " ") + (setq str (- str 1))) + (insert "-") + ;; region を delete する。 + (delete-region (point) (+ len (point)))) + + (let ((fill-individual-varying-indent t) + (paragraph-start "^\\($\\|[ ]*[-+]+\\)") + (paragraph-separate "^[ ]*[-+ <\t\n\f]") + (fill-end-position (make-marker))) + ;; filling. + (save-excursion + ;; 行頭の `/' 一つも段落開始扱いにするため追加。 + (unless (re-search-forward "^[ ]*[-+ /<\t\n\f]" nil t nil) + ;; 以降に段落相当が無いので、これが最後のリスト項目と看倣す。 + (goto-char (point-max))) + ;; indent が次の段落の先頭まで反映されてしまうことが + ;; あるので。 + (set-marker fill-end-position (1- (line-beginning-position)))) + (save-excursion + ;; overlay set. + (setq ovr + (make-overlay (line-beginning-position) fill-end-position)) + (overlay-put ovr 'face pukiwiki-view-list-face) + (overlay-put ovr 'priority 1) + ;; 左マージンを設定して、段落詰め込み。 + (set-left-margin (point) fill-end-position margin) + (condition-case err + (fill-individual-paragraphs (line-beginning-position) + fill-end-position t) + (error + (message "Error fill-individual-paragraphs: %s" + (error-message-string err))))) + (set-marker fill-end-position nil)))))))) + +;; simple element replacing. +(defun pukiwiki-insert-simple-elements () + "単純なエレメントを置換する。" + + (goto-char (point-min)) + (while (re-search-forward "^#\\(br\\|hr\\)" nil t) + (cond + ((string= (match-string 1) "br") + (replace-match "\n")) + ((string= (match-string 1) "hr") + (replace-match (make-string fill-column ?\055)))))) +;; paragraph formatting. (defun pukiwiki-insert-paragraph () "段落書式を整形する。 段落を現わす行頭書式文字 `~' が指定されているとき、以下の箇所に空行を挿入する。 - 段落直前 -- 段落先頭行の直後の行が、異なる段落や書式の場合にその直前の行 +- 次に現われる段落先頭行の直前の行 現状はこれだけで十分かと思います。" @@ -3134,9 +5015,12 @@ (delete-region (match-beginning 0) (match-end 0)) (save-excursion - (forward-line 1) + ;; 2004.09.26 もう少し精度を上げてみる。 + ;; (forward-line 1) + (re-search-forward "^[-+ |*>#~/]" nil t) (if (string-match - "^[-+ |*>#~]" + ;; 行頭の `/' 一つも段落開始扱いにするため追加。 + "^[-+ |*>#~/]" (buffer-substring (line-beginning-position) (+ (line-beginning-position) 1))) (progn @@ -3164,22 +5048,271 @@ (defun pukiwiki-set-auto-face () (when pukiwiki-auto-face (pukiwiki-set-bold) + (pukiwiki-set-bold 'strikethru) (pukiwiki-set-face-color) (pukiwiki-set-justification))) (defun pukiwiki-mode-auto-insert () (save-excursion + ;; with delete url description. + (pukiwiki-insert-anchor + (cdr (assoc 'delete-url-description pukiwiki-style-anchor-regexp-alist))) + + (pukiwiki-insert-aname) + ;; 記述の削除が伴なうので、整形前に移動。 + (pukiwiki-set-auto-face) + (pukiwiki-text-reformating) (pukiwiki-insert-paragraph) (pukiwiki-insert-cite) - (pukiwiki-insert-comment) + (pukiwiki-insert-comment) ; include pukiwiki-insert-anchor(). (pukiwiki-insert-list) (pukiwiki-insert-ls2) + (pukiwiki-insert-simple-elements) + + ;; to leave url description. + (pukiwiki-insert-anchor + (cdr (assoc 'leave-url-description pukiwiki-style-anchor-regexp-alist))) + (pukiwiki-insert-attach-file-list) - (pukiwiki-set-auto-face) + ;; 記述の削除が伴なうので、整形前に移動。 + ;; (pukiwiki-set-auto-face) (pukiwiki-delete-blank-line) + (pukiwiki-set-content-chip-away-property-at) + (pukiwiki-replace-tilda-to-blank-line) )) +(defun pukiwiki-replace-tilda-to-blank-line () + ;; ここまで来て残っている `~' は空行の筈なので。 + (goto-char (point-min)) + (while (re-search-forward "~\\s-*$" nil t) + (replace-match "\n" nil nil))) + +(defun pukiwiki-insert-aname () + (goto-char (point-min)) + (let ((pos (point))) + (when pukiwiki-auto-anchor + (while (re-search-forward "&aname(\\([^)]+\\));" nil t) + (let ((start (match-beginning 0)) + (end (match-end 0)) + (anchor-name (match-string 1))) + ;; aname element delete. + (delete-region start end) + (setq end (1+ start)) + ;; property set. + (add-text-properties start end (list 'aname anchor-name)) + )))) + ;; 見出し参照を anchor に。 + (goto-char (point-min)) + (let ((pos (point))) + (when pukiwiki-auto-anchor + (while + (re-search-forward "^\\s-*\\*+.+\\[+\\([^]]+\\)\\]+[^\n\r]*$" nil t) + (let ((start (match-beginning 1)) + (end (match-end 1)) + (anchor-name (match-string 1))) + ;; aname element delete. + (delete-region start end) + (setq end start) + ;; 前後の bracket を削る。 + (pukiwiki-view-chip-away-bracket-around-region start end) + ;; property set. + (setq anchor-name + (when (string-match "^#\\(.+\\)$" anchor-name) + (match-string 1 anchor-name))) + (setq start (line-beginning-position)) + (unless (get-text-property start 'aname) + (setq end (line-end-position)) + (let (pos) + (when (> end (setq pos + (or (next-single-property-change start 'aname) + end))) + (setq end pos))) + (add-text-properties (line-beginning-position) end + (list 'aname anchor-name))) + ))))) + +(defun pukiwiki-view-jump-to-aname (aname) + (let ((pos (point)) + pos1 found res) + (catch 'found + (setq pos1 pos) + (while (setq res (next-single-property-change pos1 'aname nil nil)) + (if (string= aname (get-text-property res 'aname)) + (progn (setq found t) + (throw 'found t)) + (setq pos1 res)))) + (unless found + (catch 'found + (setq pos1 pos) + (while (setq res (previous-single-property-change pos1 'aname nil nil)) + (if (string= aname (get-text-property res 'aname)) + (progn (setq found t) + (throw 'found t)) + (setq pos1 res))))) + (if res (goto-char res) + (message (format "Not found anchor: %s." aname))))) + +(defun pukiwiki-view-chip-away-bracket-around-region (start end) + (if pukiwiki-view-chip-away-bracket + (let ((pos1 start) (pos2 end) (count1 0) (count2 0)) + (save-excursion + ;; 直前の空き bracket. + (goto-char pos1) + (when (> (point) (point-min)) ; バッファ先頭ならもう進めない。 + (forward-char -1)) + (while (= (char-after) ?\[) + (delete-char 1) + (setq count1 (1+ count1)) + (when (> (point) (point-min)) ; バッファ先頭ならもう進めない。 + (forward-char -1))) + ;; 直後の閉じ bracket. + (setq pos2 (- pos2 count1)) + (goto-char pos2) + (catch 'reaching-point-max + (while (= (char-after) ?\]) + (delete-char 1) + (setq count2 (1+ count2)) + (when (>= (point) (point-max)) ; バッファ末尾になったら抜ける。 + (throw 'reaching-point-max t)))) + (setq pos2 (- pos2 count2)) + (cons count1 count2))) + (cons 0 0))) + +(defvar pukiwiki-auto-anchor t) +(defun pukiwiki-insert-anchor-subr (type value face start end) + ;; property set. + (pukiwiki-set-content-anchor-property start end type value) + ;; overlay set. + (setq ovr (make-overlay start end)) + (overlay-put ovr 'face face) + (overlay-put ovr 'priority 1)) + +(defun pukiwiki-insert-anchor (regexp-alist) + (goto-char (point-min)) + (let ((pos (point)) value) + (when pukiwiki-auto-anchor + (while (setq result-list (pukiwiki-search-anchor pos regexp-alist)) + (let ((start (car result-list)) + (end (cdr result-list)) + url delete-count interwiki-delete-flag) + (cond + ((string-match "\\(\\(ht\\|f\\)tps*://[^ ]+\\)\\(\\s-+\\)\\(.+\\)$" + (buffer-substring-no-properties start end)) + ;; url entry delete. + (let* ((offset1 (match-end 1)) + (offset2 (match-end 3)) + (url + (buffer-substring-no-properties start (+ start offset1)))) + (delete-region start (+ start offset2)) + (setq end (- end offset2)) + ;; set property and overlay. + (pukiwiki-insert-anchor-subr 'url url + 'pukiwiki-view-url-face start end) + ;; 前後の bracket を削る。 + (setq delete-count + (pukiwiki-view-chip-away-bracket-around-region start end)))) + + ;; 2004.09.21 url が後半にあるタイプの anchor に対処してみる。 + ((string-match "\\([^:]+\\)\\([>:]\\)\\(\\(ht\\|f\\)tps*://[^ ]+\\)$" + (buffer-substring-no-properties start end)) + ;; url entry delete. + (let* ((offset1 (match-beginning 3)) + (offset2 (match-beginning 2)) + (url + (buffer-substring-no-properties (+ start offset1) end))) + (delete-region (+ start offset2) end) + (setq end (+ start offset2)) + ;; set property and overlay. + (pukiwiki-insert-anchor-subr 'url url + 'pukiwiki-view-url-face start end) + ;; 前後の bracket を削る。 + (setq delete-count + (pukiwiki-view-chip-away-bracket-around-region start end)))) + + ((string-match (car pukiwiki-view-no-bracket-url-regexp) + (buffer-substring-no-properties start end)) + (let ((url (buffer-substring-no-properties start end))) + (when (null (string-match "https*://" url)) + (setq url (concat "h" url))) + ;; set property and overlay. + (pukiwiki-insert-anchor-subr 'url url + 'pukiwiki-view-url-face start end) + ;; 前後の bracket を削る。 + (setq delete-count + (pukiwiki-view-chip-away-bracket-around-region start end)))) + + ;; InterWikiName + ((string-match + "^\\(\\([^]:|]+\\)\\(>+\\)\\)*\\(\\([^]:|]+\\):+.+\\)$" + (buffer-substring-no-properties start end)) + (if (match-string 1 (buffer-substring-no-properties start end)) + (progn + (setq offset (match-beginning 3)) + (setq interwiki-delete-flag t)) + (setq offset (match-beginning 5))) + (setq interwikiname (match-string + 5 (buffer-substring-no-properties start end))) + (setq value (match-string + 4 (buffer-substring-no-properties start end))) + + ;; page name entry delete. + (when interwiki-delete-flag + (delete-region (+ start offset) end) + (setq end (+ start offset))) + ;; set property and overlay. + (pukiwiki-insert-anchor-subr 'pagename value + 'pukiwiki-view-anchor-face start end) + ;; 前後の bracket を削る。 + (setq delete-count + (pukiwiki-view-chip-away-bracket-around-region start end))) + + ;; alias. + ((string-match "^\\([^>]+\\)\\(>+\\)\\(.+\\)$" + (buffer-substring-no-properties start end)) + (let* ((offset (match-beginning 2)) + (value (match-string + 3 (buffer-substring-no-properties start end)))) + ;; ページ名が無いときは現在ページのページ名を。 + (when (string-match "^#" value) + (setq value (concat pukiwiki-pagename value))) + ;; page name entry delete. + (delete-region (+ start offset) end) + (setq end (+ start offset)) + ;; set property and overlay. + (pukiwiki-insert-anchor-subr 'pagename value + 'pukiwiki-view-anchor-face start end) + ;; 前後の bracket を削る。 + (setq delete-count + (pukiwiki-view-chip-away-bracket-around-region start end)))) + + ;; page name. + ((string-match "^.+$" + (buffer-substring-no-properties start end)) + (let ((value (buffer-substring-no-properties start end))) + (while (string-match "\n+ *" value) + (setq value (replace-match "" nil nil value))) + ;; ページ名が無いときは現在ページのページ名を。 + (when (string-match "^#" value) + (setq value (concat pukiwiki-pagename value))) + ;; set property and overlay. + (pukiwiki-insert-anchor-subr 'pagename value + 'pukiwiki-view-anchor-face start end) + ;; 前後の bracket を削る。 + ;; bracket で囲まれた文字列が空白だけの場合に残すか削るか微妙。 + ;; (if (string-match "^\\s-*$" value) + ;; (setq delete-count (cons 0 0)) + ;; (setq delete-count + ;; (pukiwiki-view-chip-away-bracket-around-region + ;; start end))))) + (setq delete-count + (pukiwiki-view-chip-away-bracket-around-region + start end)))) + (t + (setq delete-count (cons 0 0)))) + + (setq pos (- end (car delete-count) (cdr delete-count)))))))) + (defun pukiwiki-outline-renumber () "Renumber headings in buffer." (interactive) @@ -3212,7 +5345,8 @@ (insert " ") (while (not (= header 0)) (insert "1.") - (setq header (- header 1)))) + (setq header (- header 1))) + (insert " ")) ; YYYY.MM.DD などの見出しが異常になるので。 (goto-char (point-min)) (if (re-search-forward "^#contents" nil t) ()