comparison lisp/mh-e/mh-utils.el @ 69278:ade4a047af1b

* mh-compat.el (mh-image-load-path-for-library): Move here from mh-utils.el and wrap with mh-defun-compat since this function will be soon added to image.el. * mh-utils.el (mh-image-load-path-for-library): Move to mh-compat.el. (mh-normalize-folder-name): Add return-nil-if-folder-empty argument which is useful when calling mh-normalize-folder-name to process the folder argument for the folders command. (mh-sub-folders): Use new flag to mh-normalize-folder-name to make this function more robust. It could too easily list the folders in /. (mh-folder-list): Fix a couple of problems pointed out by Thomas Baumann. Set folder to nil if empty. Don't append "/" if folder nil.

69277:ffbb561abb59

;;;###mh-autoload
(defun mh-delete-line (lines)
  "Delete the next LINES lines."
  (delete-region (point) (progn (forward-line lines) (point))))

;;;###mh-autoload
(defun mh-image-load-path-for-library (library image &optional path)
  "Return a suitable search path for images of LIBRARY.

Images for LIBRARY are searched for in \"../../etc/images\" and
\"../etc/images\" relative to the files in \"lisp/LIBRARY\", in
`image-load-path', or in `load-path'.

This function returns value of `load-path' augmented with the
path to IMAGE.  If PATH is given, it is used instead of
`load-path'.

Here is an example that uses a common idiom to provide
compatibility with versions of Emacs that lack the variable
`image-load-path':

  (let ((load-path
         (image-load-path-for-library \"mh-e\" \"mh-logo.xpm\" 'load-path))
        (image-load-path
         (image-load-path-for-library \"mh-e\" \"mh-logo.xpm\" 'image-load-path)))
    (mh-tool-bar-folder-buttons-init))"
  (unless library (error "No library specified"))
  (unless image   (error "No image specified"))
  (let ((image-directory))
    (cond
     ;; Try relative setting.
     ((let (library-name d1ei d2ei)
        ;; First, find library in the load-path.
        (setq library-name (locate-library library))
        (if (not library-name)
            (error "Cannot find library %s in load-path" library))
        ;; And then set image-directory relative to that.
        (setq
         ;; Go down 2 levels.
         d2ei (expand-file-name
               (concat (file-name-directory library-name) "../../etc/images"))
         ;; Go down 1 level.
         d1ei (expand-file-name
               (concat (file-name-directory library-name) "../etc/images")))
        (setq image-directory
              ;; Set it to nil if image is not found.
              (cond ((file-exists-p (expand-file-name image d2ei)) d2ei)
                    ((file-exists-p (expand-file-name image d1ei)) d1ei)))))
     ;; Check for images in image-load-path or load-path.
     ((let ((img image)
            (dir (or
                  ;; Images in image-load-path.
                  (mh-image-search-load-path image)
                  ;; Images in load-path.
                  (locate-library image)))
            parent)
        ;; Since the image might be in a nested directory (for
        ;; example, mail/attach.pbm), adjust `image-directory'
        ;; accordingly.
        (and dir
             (setq dir (file-name-directory dir))
             (progn
               (while (setq parent (file-name-directory img))
                 (setq img (directory-file-name parent)
                       dir (expand-file-name "../" dir)))
               (setq image-directory dir)))))
     (t
      (error "Could not find image %s for library %s" image library)))

    ;; Return augmented `image-load-path' or `load-path'.
    (cond ((and path (symbolp path))
           (nconc (list image-directory)
                  (delete image-directory
                          (if (boundp path)
                              (copy-sequence (symbol-value path))
                            nil))))
          (t
           (nconc (list image-directory)
                  (delete image-directory (copy-sequence load-path)))))))

;;;###mh-autoload
(defun mh-make-local-vars (&rest pairs)
  "Initialize local variables according to the variable-value PAIRS."
  (while pairs

        (loop for x in (gethash grand-parent mh-sub-folders-cache)
              when (equal (car x) child2)
              do (progn (setf (cdr x) t) (return)))))))

(defun mh-normalize-folder-name (folder &optional empty-string-okay
                                        dont-remove-trailing-slash)
  "Normalizes FOLDER name.

Makes sure that two '/' characters never occur next to each
other. Also all occurrences of \"..\" and \".\" are suitably
processed. So \"+inbox/../news\" will be normalized to \"+news\".

at the front if FOLDER lacks one. If non-nil and FOLDER is the
empty string then nothing is added.

If optional argument DONT-REMOVE-TRAILING-SLASH is non-nil then a
trailing '/' if present is retained (if present), otherwise it is
removed."
  (when (stringp folder)
    ;; Replace two or more consecutive '/' characters with a single '/'
    (while (string-match "//" folder)
      (setq folder (replace-match "/" nil t folder)))
    (let* ((length (length folder))
           (trailing-slash-present (and (> length 0)

                                       (equal (aref folder 0) ?/))))
      (when (and (> length 0) (equal (aref folder 0) ?@)
                 (stringp mh-current-folder-name))
        (setq folder (format "%s/%s/" mh-current-folder-name
                             (substring folder 1))))
      ;; XXX: Purge empty strings from the list that split-string returns. In
      ;;  XEmacs, (split-string "+foo/" "/") returns ("+foo" "") while in GNU
      ;;  Emacs it returns ("+foo"). In the code it is assumed that the
      ;; components list has no empty strings.
      (let ((components (delete "" (split-string folder "/")))
            (result ()))
        ;; Remove .. and . from the pathname.
        (dolist (component components)
          (cond ((and (equal component "..") result)

          (when (not (equal folder ""))
            (setq folder (substring folder 0 (1- (length folder))))))
        (when leading-slash-present
          (setq folder (concat "/" folder)))))
    (cond ((and empty-string-okay (equal folder "")))
          ((equal folder "") (setq folder "+"))
          ((not (equal (aref folder 0) ?+)) (setq folder (concat "+" folder)))))
  folder)

(defmacro mh-children-p (folder)
  "Return t if FOLDER from sub-folders cache has children.
The car of folder is the name, and the cdr is either t or some

Respects the value of `mh-recursive-folders-flag'. If this flag
is nil, and the sub-folders have not been explicitly viewed, then
they will not be returned."
  (let ((folder-list))
    ;; Normalize folder. Strip leading +. Add trailing slash (done in
    ;; two steps to avoid infinite loops when replacing "/*$" with "/"
    ;; in XEmacs). If no folder is specified, ensure it is nil to
    ;; ensure we get the top-level folders; otherwise mh-sub-folders
    ;; returns all the files in / if given an empty string or +.
    (when folder
      (setq folder (mh-replace-regexp-in-string "^\+" "" folder))
      (setq folder (mh-replace-regexp-in-string "/+$" "" folder)))
    ;; Add provided folder to list, unless all folders are asked for.
    (unless (null folder)
      (setq folder-list (list folder)))
    (loop for f in (mh-sub-folders folder) do
          (setq folder-list
                (append folder-list
                        (if (mh-children-p f)
                            (mh-folder-list (concat folder "/" (car f)))
                          (list (concat folder "/" (car f)))))))
    folder-list))

;;;###mh-autoload
(defun mh-sub-folders (folder &optional add-trailing-slash-flag)
  "Find the subfolders of FOLDER.

results of the actual folders call.

If optional argument ADD-TRAILING-SLASH-FLAG is non-nil then a
slash is added to each of the sub-folder names that may have
nested folders within them."
  (let* ((folder (mh-normalize-folder-name folder))
         (match (gethash folder mh-sub-folders-cache 'no-result))
         (sub-folders (cond ((eq match 'no-result)
                             (setf (gethash folder mh-sub-folders-cache)
                                   (mh-sub-folders-actual folder)))
                            (t match))))

69278:ade4a047af1b

;;;###mh-autoload
(defun mh-delete-line (lines)
  "Delete the next LINES lines."
  (delete-region (point) (progn (forward-line lines) (point))))

;;;###mh-autoload
(defun mh-make-local-vars (&rest pairs)
  "Initialize local variables according to the variable-value PAIRS."
  (while pairs

        (loop for x in (gethash grand-parent mh-sub-folders-cache)
              when (equal (car x) child2)
              do (progn (setf (cdr x) t) (return)))))))

(defun mh-normalize-folder-name (folder &optional empty-string-okay
                                        dont-remove-trailing-slash
                                        return-nil-if-folder-empty)
  "Normalizes FOLDER name.

Makes sure that two '/' characters never occur next to each
other. Also all occurrences of \"..\" and \".\" are suitably
processed. So \"+inbox/../news\" will be normalized to \"+news\".

at the front if FOLDER lacks one. If non-nil and FOLDER is the
empty string then nothing is added.

If optional argument DONT-REMOVE-TRAILING-SLASH is non-nil then a
trailing '/' if present is retained (if present), otherwise it is
removed.

If optional argument RETURN-NIL-IF-FOLDER-EMPTY is non-nil, then
return nil if FOLDER is \"\" or \"+\". This is useful when
normalizing the folder for the \"folders\" command which displays
the directories in / if passed \"+\". This is usually not
desired. If this argument is non-nil, then EMPTY-STRING-OKAY has
no effect."
  (cond
   ((if (and (or (equal folder "+") (equal folder ""))
             return-nil-if-folder-empty)
        (setq folder nil)))
   ((stringp folder)
    ;; Replace two or more consecutive '/' characters with a single '/'
    (while (string-match "//" folder)
      (setq folder (replace-match "/" nil t folder)))
    (let* ((length (length folder))
           (trailing-slash-present (and (> length 0)

                                       (equal (aref folder 0) ?/))))
      (when (and (> length 0) (equal (aref folder 0) ?@)
                 (stringp mh-current-folder-name))
        (setq folder (format "%s/%s/" mh-current-folder-name
                             (substring folder 1))))
      ;; XXX: Purge empty strings from the list that split-string
      ;; returns. In XEmacs, (split-string "+foo/" "/") returns
      ;; ("+foo" "") while in GNU Emacs it returns ("+foo"). In the
      ;; code it is assumed that the components list has no empty
      ;; strings.
      (let ((components (delete "" (split-string folder "/")))
            (result ()))
        ;; Remove .. and . from the pathname.
        (dolist (component components)
          (cond ((and (equal component "..") result)

          (when (not (equal folder ""))
            (setq folder (substring folder 0 (1- (length folder))))))
        (when leading-slash-present
          (setq folder (concat "/" folder)))))
    (cond ((and empty-string-okay (equal folder "")))
          ((equal folder "")
           (setq folder "+"))
          ((not (equal (aref folder 0) ?+))
           (setq folder (concat "+" folder))))))
  folder)

(defmacro mh-children-p (folder)
  "Return t if FOLDER from sub-folders cache has children.
The car of folder is the name, and the cdr is either t or some

Respects the value of `mh-recursive-folders-flag'. If this flag
is nil, and the sub-folders have not been explicitly viewed, then
they will not be returned."
  (let ((folder-list))
    ;; Normalize folder. Strip leading + and trailing slash(es). If no
    ;; folder is specified, ensure it is nil to avoid adding the
    ;; folder to the folder-list and adding a slash to it.
    (when folder
      (setq folder (mh-replace-regexp-in-string "^\+" "" folder))
      (setq folder (mh-replace-regexp-in-string "/+$" "" folder))
      (if (equal folder "")
          (setq folder nil)))
    ;; Add provided folder to list, unless all folders are asked for.
    ;; Then append slash to separate sub-folders.
    (unless (null folder)
      (setq folder-list (list folder))
      (setq folder (concat folder "/")))
    (loop for f in (mh-sub-folders folder) do
          (setq folder-list
                (append folder-list
                        (if (mh-children-p f)
                            (mh-folder-list (concat folder (car f)))
                          (list (concat folder (car f)))))))
    folder-list))

;;;###mh-autoload
(defun mh-sub-folders (folder &optional add-trailing-slash-flag)
  "Find the subfolders of FOLDER.

results of the actual folders call.

If optional argument ADD-TRAILING-SLASH-FLAG is non-nil then a
slash is added to each of the sub-folder names that may have
nested folders within them."
  (let* ((folder (mh-normalize-folder-name folder nil nil t))
         (match (gethash folder mh-sub-folders-cache 'no-result))
         (sub-folders (cond ((eq match 'no-result)
                             (setf (gethash folder mh-sub-folders-cache)
                                   (mh-sub-folders-actual folder)))
                            (t match))))